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ABSTRACT 



The design and partial implementation of the PASCAL 



programming language for use on 


a microprocessor-based 


system is described. The framework 


for the implementation 


is comprised of two subsystems# a 


compiler which generates 



code for a hypothetical zero-address machine and a 
translator that generates code for the target 6080 



microcomputer. The Portions of 


the system which are 


implemented are written in the PL/M 


programming language to 


run in a diskette-based environment 


with at least i£K oytes 


of memory. 
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I . INTRODUCTION 



A . an INTRODUCTION TO THE PASCAL LANGUAGE 

PASCAL was the first programming language to embody the 
conceot of st ructurea programming defined by Edsger Dykstra 
and C. A. R . Hoare 17 ] , and was developed by Nicklaus wirth 
at Eigenossisch Technische Hochschule in Zurich/ 
Switzerland. Preliminary versions of the PASCAL language 
were drafted in 1968 following the spirit of the ALGOL-60 
ana ALGOL- W or og ramming languages [10]. The first PASCAL 
compiler became ooerat ional in 1970 and its publication 
followea a year later. In 1973/ a revised PASCAL report was 
pub 1 i shea consol i aat i nq revisions resulting from two years 
of use ana experience. 

The development of the language PASCAL was based upon 
two orincioal aims: to be more oowerful than its 
predecessors and to provide a suitable language to teach 
structured programming. The extensions of PASCAL relative 
to ALGOL-60 lie in the data structuring facilities that 
expand its range of applicability. PASCAL introduces record 
and file structures that make it possible to program both 
commercial and scientific applications. 
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6. OBJECTIVES OF NP S-PASCAL 



The major objective of the project described here was to 
provide the basis for an implementation of the PASCAL 
language on an Intel BOBO microcomputer system. PASCAL was 
chosen because of its flexible tyoe declarations as well as 
its structured programming constructs. The rapid 
development and decreasing costs of microcomputer hardware# 
couoled with sophisticated comoatible software is allowing 
the microcomputer to be used in a large number of 
applications. The availability of another high level 
language for these systems can only increase their 
usefulness and acceptability. 

NPS-PASCAL was cevelopea to run on an 8 0 80 based 
microcomouter system using the high level language PL/M 19], 
PL/M is implemented through a cross compiler for 8080 
microprocessor systems# and executes on the Naval 
Postgraduate School's IBM 3 o 0 computer. The availability of 
the 8080 based CP/M cisk operating system simulator (CPSYM) 
on the IBM 3 b 0 # with its powerful debugging capabilities# 
was also an important factor in the choice of the 8080 
microprocessor and the CP/M operating system. 
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NPS-PASCAL LANGUAGE DESCRIPTION 



I I . 

A. BACKGROUND 

NPS-PASCAL is an implementation of PASCAL with slight 
deviations to allow NPS-PASCAL to be specified by an LALR(l) 
grammar form. This permitted the use of the University of 
Toronto's comoiler-compiler parse table generator [IS]. 
NPS-PASCAL allows simple conversions to PASCAL and back 
which will become i ncreasi nal y important as the number of 
available PASCAL application proqrams increases. The 
differences oetween the PASCAL structure and NPS-PASCAL are 
given below. 

B. FEATURES OF THE NPS-PASCAL LANGUAGE 

1. NPS-PASCAL Declarations 

NPS-PASCAL recuires that all labels/ constants/ user 
defined types/ and variables be declared prior to their use 
in the program body. This is accomplished by a series of 
declarations and definitions in sequence at the beginning of 
the program. The program heading is used to declare the 
input and output files which can be accessed by the program. 
The incut and output declarations are discussed in section 
5. Procedures functions/ which may contain local 

declarations/ must also be defined prior to their invocation 
in the Proaram. Althouah procedure and function calls were 



not implemented in NPS-PASCAL, 



it was intended that these 



structures 


would be recursive. 












a . 


Label Declarations 














Labels are used by 


NPS-PASCAL 


as the 


target 


o f 


a 1 1 


GOTO 


statements in the 


D r oq r am . 


Laoe 1 s 


can be 


any 



positive integer value up to thirty digits in length. This 

«> 

differs from PASCAL. NPS-PASCAL treats the label as a 

identifier while PASCAL recognizes it as an integer value, 
when labels are used in the program their declaration must 
appear immediately following the program heading. The only 
factor that restricts the number of labels in a given 
program is the available memory of the microcomputer 
executing the NPS-PASCAL comoiler. Sufficient memory must 
be available after the compiler is loaded for the symbol 
table entries generated oy each label declaration. This 
size restriction also applies to all declarations. 

d • Constant Declarations 

Constant declarations enable the programmer to 
introduce an identifier as a synonym for a valid constant. 
A constant is either a number/ a constant identifier 

(possibly signed) or a string. Constant identifiers usually 
allow a Programmer to write more readable and self- 
documenting programs. 

c. Type Declarations 

One of the qreatest strengths of the PASCAL 
language is the ability to define unique data types. In 



NPS-PASCAL there are four standard types: Boolean/ Integer/ 
Char (character)/ and Peal* Inteaers may be any value 
between -32,768 and +32,767. Peal values are represented 
internally in an exponential format and can take on any 
positive or negative value consisting of fourteen digits 
multiplied Py ten to the - 6 4 1 h power through ten to the 
+63rd power. Characters may oe any valid ASCII character. 
The two identifier constant values of TRUE and FALSE can be 
assigned to a variable of type Boolean* 

In addition to the above scalar types/ there 
exists the capability of declaring a user defined scalar 
type. A series of identifiers in sequence can be given an 
identifying name, making up this user defined type* A type 
may also be defined as a subrange of any previously defined 
scalar tyoe/ except Boolean and real, by indicating the 
smallest and largest value in the subrange. The order in 
which the user defined scalar type identifiers are declared 
determines the highest and lowest values of that type. The 
first identifier becomes the lowest value of that type, 
while the last becomes the highest. 

Structurec types are defined by describing the 
individual types of their components and by indicating which 
structuring method is to be applied. This determines each 
component’s location in the structure. NPS-PASCAL supports 
the foup tyoe structures of PASCAL: array structures, record 
structures, set structures, and file structures. 
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(1) Array Structures 

Array structures contain two or more 
components of the same declared type. Arrays are indexed 
with up to five dimensions. Each dimension is defined by a 
user defined scalar type or a subrange of the integers. 
Components may be declared as any valid tyoe. If arrays are 
nested (the components of the array are arrays) then a 
maximum of five levels are allowed. 

(2) Record Structures 

Unlike the array structure, the record 
structure’s components, called fields, are not necessarily 
of the same tyoe. Each field in the record structure must 
be assigned a valia type, which possibly could be another 
record. Nesting of records is allowed up to four levels of 
declaration. Identifiers are associated with each field, 
and are used for selection rather than a computable index 
like that of an array. Records may vary in length with the 
restriction that the variable part of each record must be 
the last portion of that record. The variant part of a 
record cannot contain another record with a variant part. 

(3) Set Structures 

The set structure defines a set of values, 
which is the power set of a declared base type. The base 
type is usually a user defined scalar type or a subrange of 
the type integer. The maximum number of elements in the set 
cannot exceed sixteen including the null set. 



(4) File Structures 



A file structure is a sequence of components 
of tne same type whose position in the file defines the 
element's order. Only one element is accessible at any one 
time during execution of a program. Subsequent items must 
be accessed sequentially. The manipulation of file 
structures was not implemented in NPS-PASCAL. 

d. Variable Declarations 

NPS-PASCAL supports botn static and dynamic 
variables. Every variable is bound to a particular type 
during declaration. Dynamic variaoles are referred to as 
pointer type variables. They each may point to only one 
declared type which provides data protection. Pointer 
variaoles may also occur in structures, as in record 
structures, which are themselves dynamically generated. 

2 . Arithmetic Processing 

Integer and binary coded decimal (BCD) arithmetic 
are supported by NPS-PASCAL. In addition, the set 
operations in (set membership), + (union), * (intersection), 
- (set difference), and all of the relational operators are 
also defined. The relational operators provided in NPS- 
PASCAL are: = (equal), <> (not equal), < - (less than or 
equal), >- (greater or equal), < (less than), and > (greater 
than). The three logical Boolean operators AND, UR, and NOT 



are also defined 



i. Control Structures 

NPS-PASCAL employs several useful control structures 
consisting of BEGIN - END blocks for compound statements, IF 
THEN and IF THEN ELSE conditional statements, CASE-OF 
selective statements, REPEAT-UNT1L, WHILE, and FOR 
repetitive statements, and procedure statements. NPS-PASCAL 
is a block structured languaae, much like ALGUL-60 in that 
each block is bracketed by a BEGIN and an END. Blocks may 
be nested within other blocks up to and including the tenth 
level of nesting. This nesting restriction also applies to 
conditional and repetitive statements. 

Unlike ALGOL-60, BEGIN -END blocks do not restrict 
the scope of defined variables within the program. All 
variable procedure and function names must be uniquely 
declared globally in the program. Variables declared within 
a procedure or function, however, have their scope limited 
to the range of that procedure. Procedure nesting is 
allowed with the same variable scope restrictions applicable 
to inner procedures or functions. Storage for statically 
declared variables remains allocated throughout the program. 
Storage for local variables within procedures and functions, 
as well as dynamically generated variables, is allocated as 
required. The storage for the dynamically assigned 
variables is returned to free storage at Vun time for 
reassignment when no longer in use. The run time storage 
allocation management routines were not implemented in NPS- 
PASCAL . 
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4. Procedures Ana Functions 

Statements which can be given user defined 
identifiers are called procedures, A procedure is invoked 
in the program by its identifier. Procedures and f u n c t i o n s 
are declared in the declaration portion of the program. 
Each may contain local variable declarations/ as explained 
above/ in addition to formal parameters. There are three 
types of acceptable formal parameter specifications: value 
parameters/ variable parameters/ and procedure or function 
parameters. Value parameters (call by value) are 
expressions in the calling statement that are evaluated once 
at activation of the procedure. The actual parameter is the 
evaluated expression. The formal parameter represents a 
local variable within the procedure. Variable parameters 
(call by reference) are addresses of variables in the 
callina program. The actual parameter is a variable whose 
indices are evaluated/ if reaui red/ prior to the execution 
of the procedure. The formal parameter is aiven the same 
address and must be of the same type when used. Procedure 
or function parameters are evaluated each time they are 
used. The actual parameter is a function or procedure 
i d e n t i f i e r • 

Functions and Procedures are declared in the same 
manner except that each function has an associated type. 
When a function is referenced in an expression/ the function 
produces a value which is returned in place of the call. 
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5, Input And Output 

NPS-PASCAL has four separate statements which 
accomplish all incut ana output for the program. READ ana 
READLN statements are used either to read from the console* 
the default input device* or from a file when one is 
specified. If a file is specified* the file name must be 
declared in the program heading* and the file type must be 
specified in a file type declaration. These rules apply to 
output files as well. Text files declared to be of tyoe 
character are a special case. For this* a call to the 

procedure READLN will read the characters specified and then 
skip to the next line (the character following the next 
carriaae return ana line feed). SPRITE and wRITELN are used 
to either write to the console* or to a file specified in 
the proaram headina. The data to be read or written is 
specified by variables or strings in quotation marks which 
are enclosed within parentheses. Any comoi nat ion of integer 
variables or quoted strinqs may be placed between 

parentheses and separated by commas. A a quotea string in a 
read statement is treated as a comment. The maximum numoer 
of characters printed on a line is 80. When the output from 
a given trtRITE* or WRITELN specification reaches 80 
characters* a carriage return and a line feed character are 
automatically issued. If the ftRITELN statement is used* the 
carriage return and line feed are generated after processing 
the final parameter in the statement. 

The built-in functions of PUT and GET were not 



implemented in NPS-PASCAL. In addition* the predicate EOF* 



which is used to mark 



the 



being processed/ was 



end of a file 



also omitted. 
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IMPLEMENTATION 



III. 



A . compiler IMPLEMENTATION 



1. Compiler Organization 

The comDiler was designed to read source language 
statements from a ciskette and to produce an intermediate 
language file while printing an optional source listing at 



the console. A 


one 


oass 


anoroac n 


was 


used to Provide a 


fast 


compilation, as 


well 


a s 


t o 


reouce 


the 


reauired work and 


size 


of the como i 1 e r . 


To 


el 


i m i na t e 


the 


need to perform a 


comp 1 et e second 


pass 


o f 


the 


source 


f i I 


e # 


labels are pi 


aced 



in the intermediate code at the position where t ft e execution 
of the program is to continue after a Drancn. This was done 
because the exact location of each branch is not known 
during the compilation phase. The resolution of label 
locations is accomplished by the code generating program as 
it scans the intermediate code. The code generating program 
is hereafter refered to as the translator. 

The sinqle pass of the compiler builds the symbol 
table# converts all numbers in the source program to their 
internal representation# generates the intermediate file on 
the disk# and provides an optional listing of the source 
statements at the console. Token and production numbers are 
also listed for each line if desired. If program errors are 
anticipated# the compiler can also suroress the generation 
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of the intermediate file by the setting of soecific toggles 
at the beginning of the orogram. 



2 . Scanner 

The scanner analyzes the source Program character by 
character and sends a seauence of tokens to the parser. The 
scanner also provides a listing of the source statements 
when directed/ eliminates comments/ and sets the compiler 
t ogg 1 es . 

The scanner is divided into four main sections which 
are selectively executed deoendi nq on the first non-blank 
character of the token. After the first character is 
scanned/ the individual section involved scans the remainder 
of the token ana olaces it in the accumulator (ACCUM). The 
first byte of ACCUM contains the length of the token. In 
the case of tokens that exceed the size of ACCUM (32 bytes) 
a continuation flag is set which permits the scanner and 
parser to subsequently accept the remainina portion of the 
token . 

The four sections of the scanner handle strings/ 
numbers/ identifiers or reserved words/ ana special 
characters. The strina processing section is invoked 
whenever the first character of a token is a single 
quotation mark. The process then analyzes each succeeding 
character until a second quotation mark is scanned 
indicating the end of the string. The program section that 
manipulates numbers determines the type of number being 
scanned as it processes each character. This determination 
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is used by subsequent routines that perform type checking 
and conversion to internal representation. When the scanner 
recognizes an identifier it searches the vocabulary table 
( V 0 C A 6 ) to determine if the identifier is a reserved word. 
If a reserved word is matched# the scanner returns the 
position of the word in the V0CA8 table to the parser. This 
position corresponds to the assigned token number. The 
VOCAB table is one of the tables provided by the L A L R ( 1 ) 
oarse table qenerator [1SJ. 

Special characters are handled separately# except in 
two cases. If a oeriod is followed Dy numeric characters 
without intervening soaces# the program section which 
processes special characters assumes that a real number is 
being scanned. This program section handles the number in 
the same manner as does the number section. 

If a pair of special characters are scanned one right 
after another# the scanner will pass both characters as a 
single toxen after assigning the token number from the VOCAB 
t ab 1 e • 

3 . Symbo 1 Table 

The symbol table is used to store the attributes of 
labels# constants# type declarations# variable identifiers# 
procedures and functions# and file declarations. The main 
function of the symbol table is to verify program semantics 
and table symbol c h a r ac t e r i s t i c s which are used in the 
generation of the intermediate code file. Access to the 
symbol table is accomplished through various primitive 
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suDrout i nes using Dased qlobal variables to uniquely address 
the elements of each entry. 

The symbol table is modeled after the AIGGL-M symbol 
table [51. It is an unordered linked list of entries which 
grows toward the top of memory. Individual entries are 
either accessed via a chained hash addressing technioue as 
illustrated in Figure 1/ or by means of address pointer 
fields contained in other entries. The later method of 
access is required since not all entries in the symbol table 
have an identifier/ called the orintname/ associated with 
t h em • 

Each location in the hash taole heads a linked list 
of entries whose orintname/ when evaluated/ results in the 
same hash value. A zero in any location in the hashtable 
indicates that there are no entries whose orintname produces 
that value. During symbol taole construction or access/ the 
global variaole PRINTNAME contains the address of a vector 
whose first element is the length of an identifier in a 
single byte/ followed by the identifier's characters 
represented in ASCII format. The variaole SYMHASH contains 
the hashcode value/ the sum of the orintname 1 s ASCII 
characters modulo 128. Entries that produce the same hash 
code value are 1 i n < e d together in the symbol taole by a 
chain which is accessed via the individual entry's collision 
field. The chain is constructed in such a way as to have 
the latest entry constructed at the head of the chain. 

There are eight different types of entries that can 
oe found in the NPS-PASCAL symbol table. Each entry 
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FIGURE 2 



contains a number of fields/ some of which are common to all 
entries^ and some of which aoply only to particular types of 
entries* All entries have the same first three fields: the 
collision field (first two bytes)/ the previous symbol table 
entry address field (PRVSSb TBLSENTR Y - located in the third 
and fourth bytes)/ and the form field (FORM - the fifth 
byte) f as shown on Figure 2 . The remaining fields are used 
to uniquely describe each entry's attributes and particular 
identifying characteristics* 



a * Labe 1 Entries 

The form field of a label entry has the constant 
byte value of zero. A single byte follows the form field 
containing the length of the label's orintname. The 
individual printname characters appear after the length 
field. A two byte field following the orintname characters 
contains a sequentially generated integer value which is 
assigned as the label's internal label number. This value 
is used as the target for branching in the intermediate 
code* An example of a label declaration with its associated 
symbol table entry is shown in Figure 5. 



b. Constant Entries 

The form field of a constant symbol table entry 
not only identifies the type of entry/ it also designates 
the particular tyoe of constant. The five valid types of 
constants are: unsigned identifier (FORM = 01H)/ signed 
identifier (FORM = 41h)/ integer (FORM = 09H)/ real value 
(FORM = 1 1 rl ) / and string constant (FORM = 19h). Each entry 
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entry 



ENTRY 



EXAMPLE LABEL DECLARATION: 
LABEL 10, 6000; 
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in the symool table has a unique three bit code in its one 
byte form field* fhe three bit code for constant entries/ 
for example/ is 001. The remaining bits in the FORM variable 
describe the particular characteristics of the type 
involved. 

Following the form field of the constant entry 
are the Drintname length field and the printname characters. 
The value of the constant follows the printname characters. 
The value field may consist of another length field and 
Drintname characters in the case of identifier and string 
constants/ or it may contain the internal representation of 
a constant number (two bytes for integer values and eight 
bytes for real values). 

c . T yoe Entries 

There are two kinds of type entries that can be 
found in the NPS-PASCAL symbol table/ a simple type entry or 
a type declaration entry. Simole tyoe entries either 
indicate that a basic type is being assigned/ or that a 
defined complex tyoe declaration is to be evaluated. In the 
later case/ the simple tyoe entry will contain a pointer to 
a type declaration entry. Type declaration entries are 
generated from user defined tyoes found in the source 
program. In some cases# a chain of tyoe declarations can be 
defined. An examole of this would be an array of the type 
array which is itself of type integer. 

The form field of a simple type entry indicates 
which basic type is being entered or accessed. An integer 
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tyoe has the F 0 R M value of ^ 2 H , a real type has the FORM 
value of 4AH, a character type has a FORM value of S2H, and 
a boolean tyoe has a FORM value of 5 A H . A FORM value of 7Ah 
indicates that a tyoe declaration entry must be accessed to 
determine the complete tyoe of the entry, Tne field 
following the form is a one byte field containinq the length 
of the printname, which is followed by the printname 
characters of the type identifier. The last t*o bytes 
contain the address of the specified type. An example of a 
simole type entry is found in Figure 4. 

A tyoe declaration entry is constructed for any 
of the seven different user definable types in NPS-PASCAL, 
consisting of scalar types, subrange types, array types, 
record types, set types, file types, and pointer types. 



Only 


tne scalar entry contains an access i D 1 


e 


printname. 


The 


rest 


of tne entries must 


be accessed vi 


a 


a pointer 


field 


found 


in other entries. 


The format 


o f 


these 


tyoe 



declaration entries is found in Tables 1 through 7. 



d. Variable Entries 

The form field of the variable entry contains a 
value which describes the type of tne variable. The values 
of the FORM and their associated types are shown in Table 8. 
Following the form field are the fields which contain the 
variable identifier's printname length ana printname 
characters. A two byte field which contains the address of 
the variable’s starting address in memory appears after the 
printname characters. This address is a relative offset 
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Simple Type Entry Example: 



MEMORY 

ADDRESS 

340AH 
3409H 
3408H 
3407H 
3406H 
3405H 
3404H 
3403H 
3402H 
340 1H 
3400H 



TYPE INT = INTEGER; 




FIELD 



Address of 
Integer type 



ASCII 


Char 


ASCII 


Char 


ASCII 


Char 


Length of 
Printname 


Form 





Previous 
Symbol Table 
Entry Address 



Collision 

Address 



SYMPLE TYPE SYMBOL TABLE ENTRY 



FIGURE 4 
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Scalar Syabol Table Entry Foraat 



Byte Nuaber 


Field Description 


0 - 1 


Collision Address 


2-3 


Previous Syabol Table 




Entry Address 


4 


Fora Field (Constant Value 07H) 


5 


Printnaae Length (LPN) 


6 - 5 + LPN 


ASCII Representation of Printname 


6 + LPN 


Ordinate Number Of Scalar Ident. 


7+LPN - 


Address Of Parent Type 


8 + LPN 





SCALAR SYMBOL TABLE ENTRY FORMAT 
TABLE 1 
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Subrange Symbol Table Entry Format 



B/te Number 


Field Description 


0 - 1 


Collision Address 


2-3 


Previous Symbol Table 
Entry Address 


4 


Form Field (Value Type of Subrange 
OPH Ordinate Elmt. 

4FH Integer Elmt. 

8FH Character Elmt. 


5-6 


Parent Address Field 


7-8 


Low Value Of Range 


9-10 


High Value Of Range 


11 - 12 


IDILfference + 1 



SUBRANGE SYMBOL TABLE ENTRY PORMAT 
TABLE 2 
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Array Symbol Table Entry Format 



Byte Number 



Field Description 



0 

2 



4 

5 



6 

8 



1 

3 



7 

9 



10 



11 - 12 
13 - 14 



17H) 



Collision Address 
Previous Symbol Table 
Entry Address 
Fora Field(Const. Val 
Number Of Dimensions 
Address Of Component Type 
Total Storage Required (No. 
Basic Type Of Components 
Type 

Ordinate 
Integer 
Character 
Real 
Complex 
Boo 1 ean 
Dimension 
Dimension 



Bytes) 



Value 

00H 

01H 

02H 

03H 

04H 

OSH 

Address 

Address 



Of 

Of 



1 

2 



it" i in 



ARRAY SYMBOL TABLE ENTRY FORMAT 



TABLE 3 



Set Symbol Table Entry Format 



Byte Number 


Field Description 


0 - 1 


Collision Address 


2-3 


Previous Symbol Table 




Entry Address 


4 


Form Field (Const. Val 27H) 


5-6 


Address Of Set Type 



SET SYMBOL TABLE ENTRY FORMAT 
TABLE 4 



File Symbol Table Entry Format 



Byte Number 


Field Description 


0 - 1 


Collision Address 


2-3 


Previous Symbol Table 




Entry Address 




Form Field (Const. Val. 2FH) 


5-6 | 


Address Of Pile Type 



FILE SYMBOL TABLE ENTRY FORMAT 
TABLE 5 



32 



Pointer Symbol Table Entry Format 



Byte Number 


Field Description 


0 - 1 


Collision Address 


2-3 


Previous Symbol Table 




Entry Address 


4 


Form Field (Const. Val 37H) 


5-6 


Address Of Pointer Type 



POINTER SYMBOL TABLE ENTRY FORMAT 
TABLE 6 



Record Symbol Table EntTy Poraat 



Byte Number 


Field Description 


0 - 1 


Collision Address 


2-3 


Previous Symbol Table 




Entry Address 


4 


Form Field (Const. Val. 1FH) 


5-6 


Maximum Record Offset (Allocation) 


7-8 


Address Of Last Record Field 



RECORD SY'Vi&bTi TABLE ‘ENTRY FORMAT 
TABLE 7 
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Record Fixed Field Symbol T able Entry Format 



Byte Number 


Field Description 


0 - 1 


Collision Address 


2 - 3 


Previous Symbol Table 




Entry Address 


4 


Form Field (Const. Val. 5FH) 


5 


Length Of Printname (LPN) 


6 - 5 LPN 


Printname Characters in ASCII 


6 + LPN - 7 «• LPN 


Address Of Parent Record 


8 + LPN - 9«- LPN 


No. Of Bytes (Storage) in Field 


1 0 ♦ LPN - 1 1 ♦ LPN 


Address Of Type Of Field 


12+LPN -13+LPN 


Offset Prom Record Base 



RECORD FIXED FIELD SYMBOL TABLE ENTRY FORMAT 

TABLE 7 A 



Record Tag Field I Variant Field Entry Foraat 



Byte Number 


Field Description 


0-1 


Collision Address 


2-3 


Previous Symbol Table 




Entry Address 


4 


Fora: Variant (Const. Val. DFH) 




Tag (Const. Val. 9FH) 


5 


Length Of Printname (LPN) 


6 - S+LPN 


Printname Characters in ASCII 


6+LPN - 7 ♦ LPN 


Address* Of Parent Record 


8 ♦ LPN - 9+LPN 


■Ncr. Bytes in Field (Tag: No of Cas< 




Cases) 


1 0 + LPN - 1 1 + LPN 


Address Of Field Type 


1 2 ♦ LPN -13+LPN 


Offset From Record Base 



RECORD TAG FIELD 5 VARIANT 



FIELD ENTRY FORMAT 



TABLE 7B 
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from the case of the variable area assiqnea by the 
translator. The length of the variable is determined oy the 
variable’s type. The compiler keeos a count of the total 
amount of storage and nesses this value to the translator at 
the completion of the compilation. The translator 
subsequently converts the relative addresses in the 
intermediate code to absolute addresses in the final target 
machine code. An example of a variable entry is given in 
Figure 5 . 

e. Procedure and Function Entries 

Although the grammar of NPS-PASCAL supports 
procedures and functions, the construction of their symbol 
table entry was not implemented. Their implementation, 
however, would parallel the same format of all the other 
entries in the symbol table. The FORM values of 0 4 H , and 
05H were reserved for this purpose. 

4 • Symbol Table Construction and Access 

Several standard construction and access 
procedures were developed for the manipulation of the symbol 
table. The procedure ENTERSVARSID is used by all routines 
which construct a symbol table entry containing an 
accessible printname. This procedure calls ENTERSLINKS to 
assign the collision and previous symbol tap I e entry address 
fields. The procedure ENTERSPNSID is then called to enter 
the printname length and printname characters. ENTER$VAR$ID 
is called with the value of FORM to be included with the 
symbol. The calling routines must subsequently enter the 
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The Form Field of Variable Entries 
Value Meaning (Type of Variable) 



03H 
OBH 
13H 
1BH 
23H 
2 BH 


Scalar-Ordinate 

Integer 

Character 

Real 

Complex 

Boolean 


FORM 


FIELD OF VARIABLE ENTRIES 




TABLE 8 
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Variable Entry Example 

VAR ABC : Boolean; 



MEMORY 

ADDRESS 

340CH 



340BH 
340 AH 
3409H 
3408H 
3407H 
3406H 
34 OSH 
3404H 
3403H 
3402H 
340 1H 
3400H 



SYMBOL TABLE 






01H 


A4H 


00H 


00H 


43H 


42H 


4 1H 


03H 


2BH 


33H 


F1H 


00H 


00H 





VARIABLE SYMBOL TABLE ENTRY 



FIGURE 5 



FIELD 



Address of 
Type 



Offset from 
relative start 
of Variable Sto. 



ASCII Char C 



ASCII Char B 



ASCII Char A 

Length of 
printname 



Form 



Previous Symtbl 
Entry address 



Collision 

Address 
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additional descriptive fields for the particular entry under 
const rue t ion. 

Symbol table access is accomplished through the use 
of the standard lookup orocedures; and pointers contained 
within entries. Ihe procedure LOOKUPiONLY can oe called 
with the address of a printname as a parameter. The 
procedure calls CHECK$PRINT$NAME to compare the symbol table 
entry's printname with that of the parameter. The hashtable 
index of the parameter is used along with the symbol table 
collision fields to access the correct entries in the table. 
The orocedure LOOKUPSPNSID was designed to accomplish the 
same task as LOOKUP $ 0 N L Y with the additional feature of 
checking the form field of the entry with a second 
oarameter. If either procedure finds a match in the symool 
table the global variable LOOKUPIADOK is set to the location 
of the starting address in the symbol table of the matched 
entry, and the value TRUE is returned to the calling 
routine. 

5 . Parser 

The parser was taken from the ALGOL-M compiler [5], 
a table driven pushdown automaton with parse tables 
generated using the LALR(k) parser generator llbl. It 
receives tokens from the scanner and analyzes them to 
determine if they are part of the NPS-PASCAL grammar. If 
the parser accepts a token/ one of the following two actions 
is taken: it may save the token and continue to reauest 
tokens for the lookahead state/ or it may recognize the 
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right part of a valid production and aoply the production 
state causinq a recuction to take place. If the parser 
determines that the token received does not constitute a 
valid riqht oart of any production in the fMPS-PASCAL 
grammar, a syntax error will be printed at the console and 
the R E C 0 V E R oroceoure is called. 

When the RECOVER procedure is called, the parser 
backs up a state ana attemots to continue parsing from that 
state. If this fails, the oarser will continue to backup 
until the end of the currently oendi nq reduction is 
encountered. At that point the invalid tokens are rejected 
and an attempt to Parse tne next token is made. This action 
continues until an acceptable token is found. 

The major data structures in the parser are the LALR 
(1) parse tables ana the parse stacks. The parse stacks 
consist of a state stack and a orintname character stack. 
The orintname character stack contains the individual 
characters of the to<ens passed by the scanner. 

6. Code Generation 

The parser not only verifies the syntax of the 
source statements, but also controls the generation of the 
intermediate code by associating semantic actions with 
production reductions. /*hen a reduction takes place, the 
SYNTHESIZE procedure is called with the production number as 
a parameter. The SYNTHESIZE procedure contains an extensive 
case statement keyed by the production number to perform the 
appropriate semantic action. The syntax of the language. 
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and the secant i c actions for each reduction 



are listed in 



Appendix D . 

8. translator organization 

The zero-address machine code translator for NPS-PASCAL 
is a too down/ modularized/ program written in PL/M 19] and 
designed for easy modification. Modules whose future 
implementation are required for the completion of a full 
compiler were included in a stub form to indicate their 
absence in the oroqram. As with any other program executed 
under the CP/M system/ the translator is loaded/ and starts 
execution at address 100 hexadecimal ( 1 0 0 h ) . Its input is 
the intermediate file <filename>.PIN generated and stored on 
disk oy the compiler. The translator makes two comolete 
passes of this file. The intermediate file contains one 
pyte numbers which represent either opcodes of the pseudo 
machine or operands sent from the compiler to the 
translator. The numerical value of the opcode is used to 
determine the orooer entry point into a large case 
statement. Each case statement in the translator generates 
the portions of object code required to produce the output 
object module. A simplified flowchart of the intermediate 
code handlinq routine is shown in Figure 6. 

On the first pass/ the translator determines the size 
of the ooject module to be generated by summing the reauired 
number of Dytes of object code needed to perform tne 
instructions of each opcode used in the intermediate file. 
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FLOWCHART OF TRANSLATOR CASE STATEMENT 



FIGURE 6 



In addition/ the translator’s first pass also determines the 
relative addresses of all branching label (LBL) instructions 
which are generated by the compiler* The label number 
serves as an index into a label table# constructed by the 
translator# where each label’s relative location in the code 
area of the object file is stored and retrieved. Label 
number zero is locatea in the two bytes following the end of 
the translator orogram in memory/ denoted by . MtMORY in 
PL/M, while the location of the nth label is at bytes 2 * n t 
.MEMORY and P * n + .MEMORY + 1. Thus the label table is 
limited only by the size of the unused port i on of memory in 
the host microcomputer. 



UDon reaching 


the 


end 


of the f i 


r s t oa s s 


o f 


the 


interrreai ate file/ 




the 


translator 


r e - i n i t i a 1 


i zes 


the 


orogram/ closes and 


re- 


ooens 


the intermediate fil 


e# opens 


the object module 


f i 1 


e / and 


bed i n s the 


second phase of 


the 



machine code translation. 

After the object file is initially opened# the 
translator generates the 8080 code to load the stack pointer 
(SP) to the maximum available address at execution time# 
which is the last byte of the CP/M Transient Program Area 
(TPA). A branch instruction is then generated to the first 
byte of the code .area. 

The ooject file’s work area and Variable Storage Area is 
located between the branch instruction and the first byte of 



the code area. 



These two areas are initialized with zero 



hexadecimal values* The work area* sixty bytes in length, 
is used for performing real arithmetic and as a scratch area 
for temporary variables. The Variable Storage Area is used 
for the storage of variables declared in the source program . 
The symbol table* which was generated by the compiler* is 
not available for use by the translator. Therefore* the 
access to variables in the Variable Storage Area is 
accomplished using the operands in the intermediate file. 

On the second pass of the intermediate file object code 
is generated at address 140H plus the number of bytes 
allocated for program variables* Figure 7 shows the object 
file as it appears at execution time in the memory of the 
m i c r oc Ofnput e r . 

The intermediate file contains two separate addressing 
schemes. Tne variaole addresses are converted to absolute 
addresses by adding the offset of the work area to each 
address. The label addresses are evaluated on the first 
pass bv counting the number of bytes of object code which 
must be generated prior to the appearance of the label in 
the intermediate file. On the second pass* the translator 
adds the offset of the work area size and the variable 
allocation size to the previously stored address. 

Two methods of code generation are used by the 
translator. Simple intermediate instructions* which require 
ten or less bytes of object code* are generated in-line. 
Complex instructions requiring more than ten bytes are 
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generated once when first encountered. Subseauent 
occurrences of the same intermediate file opcode causes the 
generation of a call to the code generated for the first 
invocation. This results in the generation of three bytes 
of ooject code for each succedinq occurrence. 

There are three routines used to generate the object 
module code. GENERATE is called for single byte generation, 
GEN$FIVE generates five bytes of code, and G $ T t N generates 
ten bytes. 

At the comoletion of the second pass the translator 
closes the object mocule file, erases the intermediate file 
and generates a completion message at the console. If an 
error is detected during translation, an error message is 
generated at the console and the program terminates. 

1. Allocation of Storage Space 

The opcode ALL is aenerated by the compiler to 
specify the number of bytes to be allocated in the object 
module ' s Variable Storage Area. In addition, each oocode in 
the intermediate file indicates the size and type of data 
that is to be operated upon. 

a. Byte Data 

Byte cata items in the object module have 
two storage modes. The data is stored in byte locations 
when in memory. However, when a byte value is loaded into 
the stack, the byte data is preceeded by a zero value byte 
ana loaded in the stack in a two byte format. A description 



as 



of the oyte storage ^odes is shown in Figures 8 and 9 . Byte 
data values are ooerated upon by the translator in byte 
format routines generated in the object file. Byte data may 
represent characters/ numbers/ or boolean data. 

b . I n t ege r Da t a 

Integers are represented by two byte values 
and are stored in memory and the system stack in the same 
format. The high order oyte is stored first followed by the 
low order byte of the integer number. The storage of 
integer numbers in memory and the stack is shown in Figures 
8 and 9. The storage follows the Processing requirements of 
the 8080 M i c roorocessor 18] to comolete moves of data from 
memory or the stack into the processor double byte 
registers* A n example of the POP and PUSH operation is 
shown in Fiaure 10. Integers are represented in two's 
complement form. They may take on values from -3b/768 to 
+36,767. The high oroer bit of the integer representation 
is the sign bit. A zero hiah order bit indicates a positive 
integer value and a one indicates a neoative value. 

c. Decimal Data 
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Succeeding bytes represent two decimal digits. The byte 
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FIGURE 10 



closest to the exponent byte represents the last two digits 
of the number while the last Dvte contains the first two 
diqits of the number. Figure 11 shows a BCD number stored 
in memory. 

The sign information byte uses the high 
order bit to indicate the sign of the number. A high order 
one bit indicates a negative number while a zero bit 
represents a positive number. The remaining seven bits 
represent the exponent and its s i q n * with a bias of 64. 
Values larger than 64 represent a biased positive exponent* 
while the values less than 64 represent exponents of 
negative sign with a result equal to the difference between 
64 and the value. This reference point allows a range of 
exponent values from - 6 4 to + o 3 . The decimal Point of the 
number is always assumed to be before the first digit. 



d. String Data 

Strings in NPS-RASCAL are 
seauent i ally. The first byte located 
address location indicates the lenqth of 
strinq of ASCII characters that follow 
arbitrarily limited to 80 characters* whi 
an output line to the console. 



stored in memory 
at the starting 
the string. The 
the 1 eng t h byte is 
ch is the length of 



2 . Arithmetic Operations 



a. Logicals 

Logical operations or boolean operations act 



on byte values of zero and one only 



A zero value indicates 
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a false while a non-zero value indicates true. Logical 
operations requi ri no comparison between two elements return 
the result of the operation in the form of a true or false 
value. Logical operations are also performed using boolean 
values to determine loaical unions/ disjunctions/ or 
como 1 emen t s . 

b . I n t ege r s 

Operations with integers are 
straightforward. Both integers are removed from the stack 
and placed in double byte registers in the 6080 
microprocessor where the requested operation is carried out. 
Operations with integers include addition/ subtraction/ 
multiplication/ division, loci cal comparisons, and 
t ransformat ions to BCD format. Except for transformations, 
all results of integer operations are returned to the stack 
in the two oyte integer format. 

c . Decimals 

Arithmetic operations with BCD numbers are 
more complex than with integers. However, the 8080 
microprocessor provides the use of the DAA operator which 
simplifies the addition operation. BCD numbers and 
temporary results are stored in the work area during all 
real operations. Calculations are carried out by moving 
decimal number pairs into the 8080 registers. The required 
operation is applied repeatedly to successive bytes until 
completion. The resulting value of the operation is 
returned to the NPS-PASCAL stack in its eight byte BCD 
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format . 

Since the default position of the decimal 
ooint in a BCD number is assumed to exist before the first 
digit, all operations must left justify each result. The 
functions of addition, subtraction, multiplication, and 
division were not included in the imolementation at this 
point* However, the .operations of complementing, 
t r ans f o rma t i on to integer format, and some logical 
comparisons were implemented. 

3. String Ooerations 

String ooerations were implemented for output and 
for comparison to determine logical equality or inequality. 
Comparisons take clace either immediately between a string 
passed in the intermediate file and a string in memory or 
between two strings located in memory, Results of the 
comparison are returned to the stack in boolean form. 



4. Inout - Output 

Inout as well as output is done interactively 
through the console. The translator reads input numbers 
from the console and transforms them into the internal form 
of either an integer or a BCD number. Similarly, the work 
area is used to convert numoers into a printable form for 
outout to the console. The routine irt RITES STRNG is used to 
generate the object code which performs all output 
operations, while the routines READS INT and READS6CD are 
used to perform all inout operations* 
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5. NPS-PASCAL Pseudo Ooerators 

The oseudo code used in NPS-PASCAL, which differs 
from the P ASCAL-<P> code 113J, is listed below. 

a. Literal Data References 

LITA: (Literal Address). This operator 
generates 8080 code to place the following two byte integer 
value on the stack. 

b. Allocation Operators 

ALL: (Allocate). This operator generates 
code that initializes the number of bytes of storage 
reouired for the V S A . The size of the V S A is provided in 
the two byte ooerand. 

L8L: (Label). This ooerator is used on the 
first oass of the translator to calculate the address of the 
label in the code area and save it in the label table using 
the next two byte integer number as the label number. 

LDIB: (Load Immediate BCD). This operator 
generates code to cl ace the following eight bytes on the 
stack. 

LDII: (Load Immediate Integer). This 
operator generates code to place the following two bytes on 
the stack. 

LOD: (Load Byte). This ooerator generates 
code to move the top two bytes on the stack into the 8080 HL 
register. The byte is then moved from its location in 
memory to the stack oreceeded by a high order zero byte. 

LODB: (Load BCD). This ooerator generates 
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code to move the top two bytes on the stack into the 8080 HL 
register/ it then increments the register by eight and moves 
eight bytes in decendi nq order from memory onto the stack. 

LODI: (Load Inteqer). This operator 
generates code to move the top two bytes on the stack into 
the 8080 HL register? it then moves two bytes from that 
location onto the stack. 

c. Arithmetic Operators 

CNVB: (Convert BCD). This operator 
generates code to reolace the BCD value of the top eight 
bytes in the stack by a two byte inteqer value. Conversion 
of the number takes place in the work area. 

C N V I : (Convert Integer). This operator 
generates coae to replace the two byte integer value on top 
of the stack by its eight byte bCD value. Conversion of the 
number takes olace in the work area. 

CNAI : (Convert Integer Preceedi nq Address). 
This operator generates code to move the top two bytes from 
the too of the stack into a save area then to move the 
following integer into the work area. Code is then 
generated to convert the integer to a BCD eight byte format. 
The resulting BCD number is then returned to the stack 
followed by the two bytes f rom the save area. 

CN2I: (Convert Inteqer Preceedi ng BCD). 
This ooerator generates code to move the two bytes from the 
too of the stack into a save area then the following BCD 
number into the work area. Code is then generated to 
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convert the BCD number to an integer number. The resulting 
integer number is then returned to the stack followed by the 
two bytes from the save area. 

ADDS: (Add BCD), This operator generates 
code to move the two BCD values from the top of the stack 
into the work area where the sum of the two numbers is 
calculated and returned to the stack in BCD format (not 
implemented). 

ADDI: (Agd Integer). This operator 
generates code to move the two integer values on the top of 
the stack to the 8080 registers where the sum of the two 
numbers is calculated and returned to the top of the stack. 

SU8B: (Subtract BCD). This operator 
generates code to move two BCD values from the top of the 
stack into the work area where the first BCD number is 
subtracted from the second BCD number. The resulting BCD 
number is returned to the too of the stack (not 
implemented) . 

SU8I: (Subtract Integer). This operator 
generates code to move the two integer values on too of the 
stack to the 8080 registers where the first integer is 
subtracted from the second integer. The resulting integer 
number is returned to the stack. 

MU LB: (Multiply BCD). This operator 
generates code to move two BCD values from the top of the 
stack into the work area where their product is calculated. 
The resulting BCD number is returned to the too of the stack 
(not imclemented). 
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m UL I : (Multiply Integer) . This operator 
generates code to move the two integer values on too of the 
stack to the working area where the product is calculated. 
The resulting inteoer number is returned to the top of the 
stack. 

D I V B : (Divide BCD). This operator 
generates code to move two BCD values from the top of the 
stack into the work area where the second BCD is divided by 
the first BCD number. The quotient is returned to the top 
of the stack in BCD format (not implemented). 

D I V I : (Divide Integer). This operator 
generates code to move the two integer values at the too of 



the stack 


to the work 


area where 


the second 


integer is 


divided 


by the first 


integer. The 


quo t i en t 


i s 


returned to 


the too of the stack in 


inteqer format. 








LSS0 : 


(Less T han 


BCD) . 


This 


ooe rat or 


generates 


code to move 


the two BCD 


values at 


the 


too of the 


stack to 


tne work area 


where the two 


numbe r s 


are 


c ompa r ea . 



If the second BCD number is smaller than the first BCD 
number, a one is returned to the stack. Otherwise a zero 
is returned (not implemented). 

LSSI: (Less Than Inteqer). This operator 
generates code to move the two integer values at the top of 
the stack to the 8080 registers where the two numbers are 
compared. If the second integer is smaller than the first 
integer, a one is returned to the stack. Otherwise a zero 
is returned. 

LEQB: (Less Than or Equal BCD). This 
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operator generates code to move the two values at the top of 
the stack to the work area where the two numbers are 
compared. If the second BCD number is smaller than* or 
equal to# the first BCD number# a one is returned to the 
stack* Otherwise a zero is returned (not implemented). 

LEO I : (Less Than or Eaual Inteaer) . This 
operator qenerates code to move the two integer values at 
the top of the stack to the 8080 registers where the two 
numbers are compared. If the second integer removed f rom 
the stack is smaller than, or equal to# the first integer a 
one is returned to the stack. Otherwise a zero is returned. 

EGLB: (Equal to BCD). This operator 
generates code to move the two BCD values on top of the 
stack to the work area where the two numbers are compared. 
If the two BCD numbers are equal a one is returned to the 
stack. Otherwise a zero is returned. 

EQLI: (Equal to Integer). This operator 
qenerates code to move the two integer values at the top of 
the stack to the 8080 registers where the two numbers are 
compared. If the two integers are equal a one is returned 
to the stack. Otherwise a zero is returned. 

NEQB: (Not Equal to BCD). This operator 
generates code to move the two BCD values at the too of the 
stack to the work area where the two numbers are compared. 
If the numbers are not equal a one is returned to the stack. 
Otherwise a zero is returned. 

NEQI: (Not Equal to Integer). This 
operator generates code to move the two integer values at 
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the too of the stack to the 8080 registers where the two 
numbers are comoared. If the numbers are not equal a one is 
returned to tne stack. Otherwise a zero is returned. 

GEQ8: (Greater Than or Equal BCD). This 
operator generates code to move the two BCD values at the 
top of the stack to the work area where the two numbers are 
compared* If the second number is greater than or equal to 
the first number a one is returned to the stack. Otherwise 
a zero is returned* 

GEQI: (Greater Than or Equal Integer), 
This operator generates code to move the two integer values 
at the too of the stack to the 8080 registers where the two 
numbers are compared* If the second number removed from the 
stack is greater th an, or equal to, tne first inteqer a one 
is returned to the stack. Otherwise a zero is returnee. 

GRT8: (Greater Than BCD). This operator 
generates code to move the two BCD values at the top of the 
stack to the work area where the two numbers are compared* 
If the second BCD number is greater than the first BCD 
number a one is returned to the stack* Otherwise a zero is 
returned (not implemented)* 

GRTI: (Greater Than Integer). This 
operator aenerates code to move the two integer numbers at 
the top of the stack to the 8080 registers where they are 
comoared. If the second number is greater than the first 
integer a one is returned to the stack. Otherwise a zero is 
returned. 

N E G B : (Neaate BCD). This operator 
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generates code to move the too two bytes on the stack to the 
8080 registers where it complements the sign bit of the BCD 
sign byte then returns the two bytes to the stack, 

NEGI: (Negate Integer), This operator 
generates code to move the integer number from the stack to 
the 8080 registers* comolements the number to its negative 
number and returns it to the stack. 

COMB: (Comolement BCD). [his operator 
generates code to move the ton eight byte BCD number from 
the stack into the work area/ finds the nine’s complement of 
the number and returns it to the stack. 

COMI: (Comolement Integer). This operator 
generates code to move the too two byte integer number into 
the 8080 registers/ finds the two's complement of the number 
and returns the value to the stack. 

d. Boolean Operators 

NOT: (Boolean Not)* This operator 
generates code to move the two bytes at the too of the stack 
into the 8080 registers and compares the low order byte* If 
the byte is zero it returns a two byte value of one to the 
stack. If the byte is one it returns a two byte value of 
zero* 

AND: (Boolean And)* This operator 
generates code to move the next two integer numbers into the 
8080 registers for logical AND comparison of their low order 
bytes. If the relation is true/ a two byte value of one is 
returned to the stac*. If the relation is not true a two 
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byte value of zero is returned to the stack. 

BOR: (Boolean Or). This operator generates 
code to move the next two integer numbers into the 8080 
reaisters for logical OR comparison of their low order 
bytes. If the relation is true# a two byte value of one is 
returned to the stack. If the relation is not truer a two 
byte value of zero is returned to the stack. 

e. String Operators 

EQLS: (Eoual String). This operator 
generates code to compare a strina whose length is given by 
the folio winq byte. It moves the two bytes at the top of 
the stack into the 8080 HL register ana compares the string 
one byte at the time for eauality. If the string in the 
sneci f ied memory location is eaual to the string in the 
intermediate filer a one is returned to tne stack. 
Otherwise a zero is returned (not i mo 1 emen t ed ) . 

MEQS: (Not Eaual String). This operator 
generates code to compare a strina whose length is qiven by 
the following byte. It moves the two bytes at the top of 
the stack into the 8080 HL register and compares the strings 
for eauality. If the string in the specified memory 
location is eaual to the string in the intermediate file# a 
zero is returned to the stack. Otherwise a one is returned 
(not i m p 1 emented) • 
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f. Stack Operators 

DCRB: (Decrement Stac* BCD). This operator 
generates code to decrement the size of the stack by eight 
bytes. 

DCRI: (Decrement Stack Integer). This 
operator generates code to decrement the size of the stack 
by two bytes. 

DCRI: (Decrement Stack Byte). This 
operator generates code to decrement the size of the stack 
by two bytes. 

g. Program Control Operators 

BRL: (Branch to Label). This operator 
calculates the label address in the laoel table using the 
next two byte laoel number and moves the coaecount stored at 
the laoel table adaress and adds to it the address of the 
start of the code area. It then generates code to branch to 
the calculated address. 

BCL: (Branch Conditional Label). This 
operator calculates the branching address in the same manner 
as the BRL coae above. It then generates the code to move 
the two bytes on top of the stack to the 8080 registers to 
check the condition. If the low order byte removed from the 
stack is a oner the branching instruction is executed. If 
the low order byte is a zero the program continues without 
b ranc h i ng . 

E N D P : (End of Program). At the end of the 
first pass of the translator this code reini tial wes the 



program, closes the intermediate file, and sets the second 
pass condition to true. On the second pass this opcode 
generates code to terminate the object code file and 
terminates compilation. 

h . Store Operat ors 

ST08: (Store BCD). This operator generates 
code to move the two Dytes at the ton the stack into the 
8080 Hi. register then moves the next eight bytes from the 
stack to memory starting at the address indicated by the HL 
register. The value of the BCD number is preserved in the 
stack by incrementing the stack pointer by eight. 

STOI: (Store Inteqer). Tnis operator 
generates code to move the two bytes at the top of the stack 
into the 8080 HL register then moves the next two Dytes from 
the stack to memory starting at the address indicated by the 
HL reaister. The value of the integer number is preserved 
in the stack by incrementing the stack pointer by two. 

STOI: (Store Byte). This operator 
generates code to move the two Dytes at the too of the stack 
into the 8080 HL register, then moves the next byte from the 
stack to memory at the address indicated by the HL register. 
The value of the oyte value is preserved in the stack by 
incrementing the stack pointer by two. 

STDB: (Store Destruct BCD). This operator 
generates code to move the two bytes at the top of the stac< 
into the 8080 HL reaister then moves the next eight bytes 
from the stack to memory at the address indicated bv the HL 
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r eg i ster 



S T D l : (itore Destruct Integer). This 
operator generates code to move the two bytes at the top of 
the stack into the 6 0 80 hi L register then moves the next two 
bytes from the stack to memory starting at the address 
indicated by the ML register. 

STD: (Store Destruct Byte)* This operator 
generates code to move the two bytes at the top of the stack 
into the 8080 HL reqister then moves the next byte from the 
stack to memory start i nq at the address indicated by the HL 
regi ster* 

i. Input - Output Ooerators 

R D V 8 : (Read Variable BCD)* This operator 
generates code to read a BCD number from the console* change 
it into its acceptable storage form, and place the eight 
byte internal form on top of the stack (not implemented). 

RDVI: (Read Variable Integer)* This 
operator generates code to read an integer number from the 
console* change it into its acceptable storage form , and 
place the two byte number on top of the stack (not 
impl emented) . 

RDVS: (Read Variable String). This 
operator generates code to read a string variable from the 
console and stores it at a location in memory indicated by 
the two top bytes on the stack (not implemented). 

/JRVB: ( '/J rite Variable BCD). This operator 
generates coae to move the eiaht byte bCD number at the top 
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of the stack into the wor< area, changes the numoer into its 
or intable form and orints the number to the console. 

rtRVI: (Write Variable Integer). This 
operator generates code to move an integer number into the 
work area, change the number into its printable form and 
orint tne number at the console. 

WRVS: (Write Variable String), This 
operator generates code to print a string variable at the 
console equal in length to the next one byte integer. Tne 
string variable follows the size byte. 

DUMP: (Start New Output Line). This 
operator generates code to send a carriage return and line 
feed to the console. 



j. Routine Operators 

PRO: (Procedure Call). This operator 
generates cooe to save the oresent address loaded in the 
orogram counter (PC) register and loads the PC register with 
the address contained in the next two bytes (not 
impl emented) • 

RTN: (Return From Procedure). This 
operator generates code to retrieve the address stored by 
the previously executed procedure and loads the PC register 
to continue the program at this location (not implemented). 

S A VP : (Save Parameters). This operator 
generates code to save the present value of the parameters 
in the next available area above the end of the object code 
(not implemented). 
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qenerat es 
above the 



UNSP: (IJnsave Parameters). This operator 

code to return the oarameter values from the area 
object code (not implemented). 
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I V . CONCLUSIONS AMD RECOMMENDATIONS 



The NP3-PASCAL project described here is the first staqe 
of a full PASCAL implementation for Intel 8080 based 
m i c r oc ompu t e r s . Althouqh incomplete/ the compiler 
structures are essentially intact/ ana the code generator is 
formul ated. 

Several features c f the PASCAL language have not been 
implemented and are indicated in the program listings. The 
structure of the heap/ which is required for recursive 
procedures and functions/ as well as record manipulations/ 
has not been designed nor implemented. Integrated program 
testing/ including timing tests/ will also oe necessary to 
determine the correctness and efficiency of the overall 
system. Enhancements/ such as formatted 1/0/ external 
subroutine library access/ and run-time debuqginq/ must also 
be designed and implemented. The structure of the symbol 
table should make run-time debugging relatively easy. 
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APPENDIX A - COMPILER ERROR MESSAGES 



DE Disk error : R e c 0 m o i 1 e . 

TO Symbol table overflow : Reduce number 

of declaret ions. 

EE Exoonent size error : See user manual. 

IE Integer size error : See user manual. 

IS Invalid subranqe error : Check type and 

limits of declared subrange. 

IT Invalid tyoe error : Array comoonent type 

specification invalid. 

IA Invalid array index : Array index types 

must be scalar - INTEGER or REAL types are 
i nva 1 id. 

NP No production : Syntax error in source line. 

IC Invalid constant variable : Constant entry 

in symbol table invalid - probably due to a 
prior error. 

IE Invalid expression type : The types of 

variables usee in an expression are 
incompatible. 

ES Expression stack overflow : Simplify program. 

IR Invalid read variable l Only INTEGER or REAL 

values can be read. 

LS Label syntax error : All labels must be 

i n t eqers . 

DC Duplicate constant name : Constant identifiers 

must be unique. 

DT Duplicate type name : Type identifiers must be 

un i que . 

TI Invalid tyoe identifier : Type identifier not 

previously declared. 

AN Array nest overflow : Simplify declaration. 



67 



AO Array dimension stack overflow : Simplify 

array declaration. 

IV Variant stack overflow : Reduce the number 

of variant cases. 

RN Record field stack overflow : Reduce the number 

of fields specified. 

VN Variable declaration stack overflow : Reduce 

the number of variables declared oer line. 

UL Undefined label error : Label not declared 

in label statement. 

AT Assignment type error : Type of expression not 

compatible with assignment variable type. 

CE Invalid expression : The variable types within 

the expression are not compatible. 

UO Invalid unary operator : Variable type must be 

INTEGER/ REAL/ or subrange of INTEGER. 

SO State stack overflow : Simplify program. 

VO Variable stack overflow : Reduce the length of 

variable printnames. 

10 If statement stack overflow : Simplify program. 
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APPENDIX B - TRANSLATOR 
MESSAGES 

Disk file close error. 

Disk file create error. 

Disk file write error. 

No internal file found. 

Integer over f 1 ow . 

Exponent overflow. 

Exponent underflow. 

Division by zero attempted. 

Invalid Console Input 

End of compilation. No proaram 



MESSAGES 



e r ro r s . 



Compilation terminated due to error(s) 



APPENDIX C NPS-PA3CAL LANGUAGE MANUAL 



This section describes the various elements of the 
NPS-PASCAL language- The format of the element will 
be shown^ followed by a description and examoles of 
its use. The following notation is used: 

Braces O indicate an optional entry. 

A vertical bar | indicates alternate choices/ one of 
which must appear . 

Reserved words are indicated by capital letters. 
Reserved words ana other special symbols must appear 
as shown. 

Items appearing in small letters are elements of the 
I anquaae which are defined and explained elsewhere 
in the language manual. 
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arithmetic expression 



ELEMENT : 

arithmetic expression 



FORMAT : 



integerldecimal 

variable 

{(} arithmetic expression binary operator 
arithmetic expression {)} 

{(> unary operator arithmetic expression {)} 
DESCRIPTION: 

Arithmetic expressions consist of basic data 
combined with arithmetic operators in 
notation. 

EXAMPLE : 

(A + B) 

-A 

C + 12.6 



elements 

algebraic 
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Array Declaration 



ELEMENT : 

Array Declaration 



FORMAT: 



VAR identifier: ARRAY (* index-type-string *) 
OF component -t yoe 

VAR identifier: ARRAY (* index-tyoe-string 
{> index-type-stringl *) 

OF component-type 



DESCRIPTION: 

Array types consist of a fixed number of 
components ; where all the components are of 
tyoe. Each component of the array variable 
directly accessed by the name of the array 
followed by its index location in the array 
in the (* notation. See assignment statement 

EXAMPLE : 

VAR temperature: ARRAY (* 1..10 *) OF REAL? 
VAR grades: ARRAY (* 1..5,2..8 *) OF INTEGER; 



declared 
the same 
can be 
variable 
enclosed 
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assignment statement 



ELEMENT : 

assignment statement 
FORMAT : 



variable := expression 
DESCRIPTION: 

Assignment statements indicate a value to be assigned 
to a variable or a value to replace the present value 
of a variable. The symbol : = is the assignment 
operator and must not be confused with the relational 
operator = indicatina eauality. The resulting value 
of the expression on the right side of the assignment 
statement must be consistent with the type of variable 
being assigned the new value. The only exception is 
that INTEGER expression types will be converted to 
REAL in the assignment to a real variable. 

EXAMPLE : 

x : = 0 / 

t empe r a t u r e ( * 2 *) : = 103.7; 

y : = (15 D I v a ) * 2 ; 
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balanced statement 



ELEMENT : 

balanced statement 



FORMAT : 



s i mp le statement 

IF {(} boolean-expression {)} THEN balanced-statement 
ELSE balanced-statement 

DESCRIPTION: 

Simple statements are statements of which no part 
constitutes another statement; therefore* it is 
considered a balanced statement. The IF conditional 
statement has parts constituting other statements. 
However, if the IF clause is balanced by an ELSE 
balanced-statement the statement is balanced. 

EXAMPLE : 

IF x > 0 THEN flag := TRUE; ELSE a : = 2; 
x := (y * 10) / b; 

goto 300; 
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block 



ELEMENT : 

block 

DESCRIPTION: 

The block preceeded by a orogram-head i ng forms the 
PASCAL program. Similarly/ the block oreceeded by a 
p roc edu re-head i ng or a function-heading forms parts of 
the Procedure and Function Declaration Part. The block 
consists of Label Declaration Part/ Constant 
Definition Part/ Type Definition Part/ Variable 
Declaration Part/ Procedure and Function Declaration 
Part/ and Statement Part. All of the parts listed may 
be empty except the last. 

EXAMPLE : 

See individual part descriptions for specific information 
on each part. 
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boolean expression 



ELEMENT : 

boolean expression 



FORMAT : 



NOT boolean-expression 

boolean-expression OR bool ean-exoress i on 

boolean-expression AND oool ean-expressi on 

{(> exoression relational-operator expression { ) 1 

DESCRIPTION: 



C o m p a r i son 


o f 


const ant 


to constant, INTEGER 


t 0 


INTEGER, 


real 


to REAL, 


RtAL to INTEGER, and strinq 


t o 


s t r i nq a r 


e a 


1 1 owed i n 


NPS-PASCAL. Comparison 


0 f 


numbers 


o f 


a i f ferent 


types are accomplished 


by 


chanqi n g 


the 


INTEGER 


number to RtAL prior 


t o 


compari son 


. The resu 1 t s 


of the comparison are recorded 


as a l if 


the 


comoa r i son 


is TRUE and as a 0 if 


the 


comoa ri son 


i s 


false . 







example : 

NOT e r r f 1 ag 

( X - 3 > 0) OR ( errflaq) 
( Y > 0 ) AND ( Y < 10) 



case statement 



FLEMENT : 

case statement: 



FORMAT : 



CASE expression OF case-1 i st -el ements-l i st » END; 



DESCRIPTION: 



The case 


exoress i on 


of the case 


statement 


i s 


the 


s e 1 ector 


for the c as e- 1 i s t -e 1 emen t s 


- 1 i s t . 


This 1 


i s t 


provides 


the choices 


of statements 


t 0 


select 


from. 


A 


statement 


whose label 


i s eaua 1 to 


the 


current 


value 


o f 



the selector is executed. 



EXAMPLE : 

CASE i OF 

1 : x : = 0 ; 

2 : x : = x ; 

3 : x : = 2x ; 

a : x : = limit; 

END 
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constant def. part 



ELEMENT : 

costant definition part 



FORMAT : 

emot y 

CONST constant-defi nit ion-1 istJ 
DESCRIPTION: 

Constant Definition Part introduces identifiers as 
synonims for constants. The constant may be a number, 
signed or unsianed constant identifier, or a string. 

Example : 

CONST least = 0; most = SOT next = a? 
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conditional statement 



ELEMENT : 

conditional statement 
DESCRIPTION: 

Conditional statements for NPS-PASCAL fall in two 
categories^ the case statement ana the IF statement. 
Language modification to have NPS-PASCAL parsable with 
one look ahead forced a distinction between two IF 
statements. See balanced statement and unbalanced 
statement. The case statement was included in the 
simple statements. 

i 

Example : 

See case statement/ balanced statement/ 
and unbalanced statement. 
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compound statement 



ELEMENT 



compound statement 



FORMAT : 

BEGIN statement-list END 
DESCRIPTION: 

Compound statements specify that the statements are 
executed in the same sequence as they are written. The 
BEGIN and END reserved words are the statement 
delimiters. A compound statement can be used whenever 
a statement is required. 



example 



BEGIN 



a 



least; 



b 

c 



: = a + 2 ; 
: = most 



END 
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data tyoe definition 



ELEMENT : 

data tvpe definition 
DESCRIPTION: 

A data tyoe determines the set of values which 
variables of that tyoe may assume. It also associates 
an identifier with the type Type. 

EXAMPLE: 

See simple type/ structured tyoe/ and pointer type. 
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declarations 



ELEMENT : 

declarations 

DESCRIPTION: 

In NPS-PASCAL all the variables* labels* functions* 
procedures* constants* and data types to be used in 
the program must be declared at the beginning of the 
program . 

EXAMPLE : 

See block. 
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expression 



ELEMENT : 

expression 

DESCRIPTION: 

There are two types of expressions in PASCAL, 
boolean expression and the arithmetic expression. 

EXAMPLE : 

See arithmetic expression and boolean expression. 



The 
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FOR statement 



ELEMENT : 

FOR statement 

FORMAT : 

FOR index-variable := i n i t i a 1 -va I ue DOWNTO final-value 
DO statement 

FOR index-variable := i n i t i a 1 - v a 1 ue TO final-value 
DO statement 

DESCRIPTION: 

FOR statements or FOR looos are iterative statements 
in PASCAL. The exoression to assign the initial value 
to tbe index variable is only evaluated once before 
the first iteration of the body of the loop. At each 
iteration the value of the index variable is changed 
automatically therefore the value of the index 
variable can not be changed within the body of the 
loop. Index variables and the result of exoressions 
giving the initial value and final value must be of 
tyoe INTEGER. 

EXAMPLE : 

FOR i := 10 DOwNTO 1 DO 

total tax := sales!* i *) * taxrate? 

FOR n := ( 3 x + 2) to (2x + 20) DO 
sum : = sum + n ; 
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Hie t yoes 



ELEMENT : 

file types 



FORMA f : 



TYPE identifier = FILE OF type? 

(if type of file is CHAR then file is textfile) 
DESCRIPTION: 

NPS-PASCAL uses the word file to soecify a structure 
consisting of a sequence of components all of which 
are of the same tyoe. Declarina a file automatical 1 y 
introduces a buffer variable pointer that indicates 
the component to read or aooend in the file. All the 
operations of a sequential file generation and 
inspection can be expressed in terms of four primitive 
file operators reset/ rewrite/ get/ and put/ with a 
controlling symbol EOF. 

EXAMPLE : 

TYPE socsecno = FILE OF INTEGER; 

TYPE text = FILE OF CHAR; 
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function call 



ELEMEN f : 

function call 



FORMAT : 

identifier := function-identifier 
identifier := function-identifier 

( formal -oarameter(s) ) 



DESCRIPTION: 

Functions may appear as primary elements in arithmetic 
or boolean expressions. The type of the function must 
be scalar/ subranqe; or pointer type. 

EXAMPLE : 

Not implemented. 
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GOTO statement 



ELEMENT : 

GOTO statement 



FORMAT : 



GOTO label 
DESCRIPTION: 

GOTO statements serve to indicate that further 
orocessing should continue at another part of the 
program text » at the location of the label. GOTO 
statements are restricted jumps within their scope. It 
is not possible to jump into procedures. Also* every 
label must be oeclared in a label declaration portion 
of the orogr am . 

EXAMPLE : 

GOTO 300 
GOTO 50 



i den t i f i e r 



ELEMENT : 

i d e n t i f i e r 



FORMAT : 



letter 

letter '{letter or digit [{letter or digit!} 
DESCRIPTION: 

Identifiers serve to denote constants^ types* 
variables* procedures* and functions. They must begin 
with a letter and may be followed by any combination 
of letters anc/or digits. Identifiers may consist of 
only one letter. Only the first eiaht characters of an 
identifier are significant; although* the lenghth of 
an identifier may be up to 32 characters. Two similar 
identifiers may be distinguishable if different in the 
first eight characters. 

EXAMPLE : 
a 

sorted 
t e s t 1 
h 2owe i qh t 
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IF statement 



ELEMENT : 

IF statement 

FORMAT : 

IF boo I e a n -e x o r e s s i on THEN unbalanced-statement 
IF boo 1 e an -e x o re s s i on THEN balanced-statement 
IF boolean-expression THEN balanced-statement 
ELSE balanced-statement 

DESCRIPTION: 

IF statements are statements of conditional execution. 
If the boolean exoression evaluates to TRUE the 
statement following the reserved word THEN is executed 
and tne ELSE statement is iqnored if applicable. If 
the boolean expression evaluates to FALSE the THEN 
statement is ignored and the ELSE statement is 
executed if applicable. 

EXAMPLE : 

IF errorflag THEN errorprocedure 
IF (A + 8) < C THEN C := A + B 
ELSE A := C 
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input 



ELEMEN t : 

incut 



FORMA [ : 



REAO(variable-name ! (»variable*name} ) 

READ ( f i 1 e-name / vari ab! e-naire ! (» vari ab I e-name) ) 
REA0LN(variab1e-1 ist) 

RE ADEN ( f i 1 e-name t va r i ab 1 e- 1 i s t ) 

DESCRIPT ION: 

The READ and READLN statements allow the user access 
to the input device to accept data for use in the 
execution of the NP3-PASCAL program. READLN allows to 
read and subsequently skip to the beginning of the 
next line* bypassing any further data on the current 
line. 

EXAMPLE : 

RE AD ( x ) 

READLN ( x , y , z ) 
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label declaration oart 



ELEMENT : 

label declaration oart 



FORMA T : 



* LABEL 1 abe l -numbe r { ( label *numberl ; 

DESCRIPTION: 

Any statement in a NPS-PASCAL program may be marked by 
prefixing it with a numerical label followed by a 
colon. This allows the statement to be referenced by a 
GOTO statement. All labels must be defined in the 
label declaration oart before tneir use. A label is an 
unsigned integer consisting of no more than 32 digits. 

EXAMPLE: 

LABEL 3; 

LABEL 5,15,20,25; 

LABEL 123456789; 



1 abe 1 



ELEMENT : 

1 abe 1 



FORMAT : 



unsianed integer 32 digits or less in length 



DESCRIPTION: 



See label declaration part 



EXAMPLE : 

50 : x : = y + 3 

23^568: if x < 0 then flag := TRUE 
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output 



ELEMENT : 

Output 

FORMAT : 

wR I TE ( f i 1 e-name/ variable-list) 

WRITE(variable-l ist) 

WRITELN(fi le“naine> variable-1 ist) 

WRITELN(variable-l ist) 

DESCRIPTION: 

The WRITE and WRITELN statements allow the program 
access to the output devices. WRITELN terminates the 
Current line of the output file after its parameters 
have been acted upon. WRITE and WRITELN permit 
documentation cf the output by outputting any 
information between quotations literally. 

EXAMPLE : 

WRITEC'the value of * is’»x) 

W R I T E L N ( X, y, 'the average is', z) 
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program heading 



ELEMENT : 

program headi ng 

FORMAT : 

PROGRAM identifier (file-identifier { , 

file-identifier}); 



DESCRIPTION: 



Program heaaing qives the NPS-PASCAL program a name 
and lists its input and output parameters* The name is 
only used for identification Purposes ana is not 
otherwise significant inside the program. The 
parameters indicate the files/devices through which 
the program communicates with its environment. 



EXAMPLE : 



PROGRAM bubbl e( i nput / output ) 

PROGRAM pri mes (output ) ; 

PROGRAM communi cate( i nf i 1 e/out f i 1 s) /* 
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P roc , and Fynct 



ELEMENT : 

Procedure and Function Declaration Part 



FORMAT : 



not imolemented 
DESCRIPTION: 

Every procedure or function used in 
oroqram must be defined before its use, 
subroutines which are activated 
statements. Functions are subroutines 
resultant value/ and therefore can 
constituents of exoressions, 

EXAMPLE: 

See procedure call/ and function call. 



a PASCAL-SM 
Procedures are 
by p roc edu re 

that yield a 
be used as 
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pointer type 



ELEMENT : 

pointer type 



FORMAT : 



TYPE identifier = itype-identifier 
DESCRIPTION : 

A pointer type is a variable bound to another 
variable. It consists of an unbounded set of values 

pointing to its bound variable. The value NIL is 
always an element of a pointer variable and points to 
no element at all. 

EXAMPLE : 

TYPE link = 5 relative 
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Procedure call 



ELEMENT : 

Procedure call 



FORMAT : 



CALL Drocedure*name {(parameter { > pa r ame t e r } ) } 
DESCRIPTION: 

Procedure calls are the statements which invoke the 
execution of a predefined procedure. Upon completion 
of the procedure the execution resumes at the next 
statement following the call. 

EXAMPLE : 

CALL print name 

CALL largest (numberl, number^) 
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Reserved words 



ELEMENT : 

Reserved words 



DESCRIPTION: 

Keywords used in NPS-PASCAL are reaserved words 
are not allowed to be used as identifiers, 
follwing list are NPS-PASCAL reserved woros: 



AND 


END 


NIL 


SE I 


ARRAY 


FILE 


NOT 


T HEN 


BEGIN 


FOR 


OF 


ro 


CASE 


FUNCTION 


OR 


TYPE 


CONST 


GOTO 


PACKED 


UNTIL 


01 V 


IF 


PROCEDURE 


VAR 


DO 


IN 


PROGRAM 


aHILE 


DOWNTO 


LABEL 


RECORD 


WITH 


ELSE 


MOD 


REPEAT 





and 

The 
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Repeat statement 



ELEMENT : 



Repeat statement 



EXAMPLE: 

REPEAT statement {/Statement} UNTIL expression 
DESCRIPTION: 

The seauence of statements is executed at least 
until the condition of the expression is met. 



EXAMPLE: 

REPEAT i UNTIL n = 10 
REPEAT & initialize arrays & 
A : = A + 1 ; 

BC* a * ) - 0.0; 

UNTIL A = 10 



once 
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Repetitive statement 



ELEMENT : 

Repetitive statement 
DESCRIPTION: 

Repetitive statements specify that certain statements 
are to be executed repeatedly. In some cases the 
number of repetitions may be known before the first 
repetitive execution. In other cases the condition to 
stop repeating the execution is determ inea after 
execution of a statement. 

EXAMPLE : 

See While statement/ repeat statement/ and 
For s t a t emen t . 
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RECORD t ypes 



ELEMENT : 

RECORD types 



FORMAT : 



TYPE record-name = RECORD field-list END 
DESCRIPTION: 

A record is a template for a structure whose parts may 
have quite distinct characteristics. It consists of a 
fixed number of components* called fields. Components 
can not be directly indexed. 

EXAMPLE : 

TYPE date = RECORD mo : ( j an * aor * j u 1 * oc t ) ; 

day : 1 . . 3 1 
year : INTEGER 



END 



remarks 



ELEMENT : 

remarks 



FORMAT : 



& comment & 



DESCRIPTION: 



Remarks 


are usea 


t o 


d 1 aced 


between 


the 


program 


w i thout 


c aus 


mean i nq . 







document proqrams 
delimiters can be 
ina an alteration in 



example : 



& beginning of 
& this routine 



execution phase & 
changes integer signs & 



Any r ema r k 
i nserted i n a 
the program's 
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read / READLN 



ELEMENT : 

READ / READLN statements 



FORMAT : 



READ(variable-l ist) 

RE AD ( f i 1 e -name / v a r i ab 1 e- 1 i s t ) 

READLN(variable-l ist) 

READLN! f i 1 e-name» va r i ab 1 e~ 1 i s t ) 

DESCRIPTION: 

The READ and READLN procedures allow input from 
external files or the default input device to the 
proqram. The first parameter is the file from which to 
access data. If the first parameter is not a file 
identifier then the default file is the default input 
device. Read statements cause the next available value 
to be read from the file and assigned to the variable 
whose name is indicated as a parameter. When more than 
one variable value is read with the same statement the 
variable names in the variable list are separated by 
commas. See inout. 

EXAMPLE : 

READ (x) 

READ ( x , y , z ) 

READLN ( x C 5 ) ) 

READLN (testl/x,p,r) 
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SET types 



ELEMENT : 

SET types 



FORMAT : 



SET OF base-type 



DESCRIPTION: 



SET 


types 


define a 


range of 


values which 


is the power 


set 


o f 


its base 


t yoe . 


Base types 


must not 


be 


structured 


types. 


Operat o rs 


a p o 1 i c a b 1 e 


to all 


set 



types are: 

+ union 

- set difference 
* i nt er sec t i on 
IN membersh i p 

EXAMPLE : 

SET OF week 
SET OF family 
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scalar t ypes 



ELEMENT : 

scalar t yoes 

FORMAT : 



scalar-tyoe-ident = ( 

DESCRIPTION: 

Scalar type defines 
enumeration of the 
values. The secuence 
declared is used in 
variables assigned this 



identifier {/identifier}) 



an ordered set of values by 
identifiers which denote these 
in which the identifiers are 
performing operations on the 
type. 



EXAMPLE : 

color = ( b 1 ue / red / wh i t e ) 
card = (jack»gueen/king,ace) 
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simple types 



ELEMENT : 

simple types 



FORMAT : 



scalar-type 
subranqe-t ype 
identifier 

DESCRIPTION: 

Simple types in NPS-PASCA|_ are the basic elements of 
all type structures. They consist of the identifiers, 
INTEGER, REAL, CHAR, and BOOLEAN. Scalar defined 
types and subranges of INTEGER types, CHAR types, and 
scalar types are also included as simple types. 

EXAMPLE : 

See scalar types, subrange types, 
and identifier. 



subrange types 



ELEMENT : 

subranqe types 

FORMAT : 

TYPE identifier : const ant . .const ant 
DESCRIPTION: 

Subranqe type is a subranqe of another already defined 
scalar type called its associate scalar type. Subranqe 
indicates the smallest and the 1 araest value in the 
subrange. Subranges of REAL are not allowed. 

EXAMPLE : 

VAR smal 1 : 1 . .5; 

workday : mon. . f ry,' 

initials : * a ' . ♦ ' z ' ? 
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st rue t ured t ypes 



ELEMENT : 

structured tyres 
DESCRIPTION: 



Structured types are 


composed of other types. Options 


ava i 1 ab 1 e to each 


structuring method indicate the 


preferea internal 


data representation. Type 


definition prefixed 


with the symbol PACKED economizes 


storage requirements 


(Packed option not implemented). 


EXAMPLE : 





See ARRAY type and RECORD type. 
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type BOOLEAN 



ELEMENT : 

type BOOLEAN 



DESCRIPTION: 

BOOLEAN types assume a BOOLEAN value, one of the 
logical truth values denoted by the predefined 
identifiers TRUE or FALSE. Logical operators and 
relational operators yield BOOLEAN values when applied 
to BOOLEAN and arithmetic operands respectively. 

EXAMPLE : 

VAR errflg : BOOLEAN; 

VAR siqnx , exponx : BOOLEAN; 
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type CHAR 



ELEMENT : 

type CHAR 



FORMA r : 



TYPE type-identifier = CHAR 
VAR va r i ab 1 e- i dent i f i er : CHAR 

DESCRIPTION: 

The value of type CHAR is an element of a finite and 
ordered set of characters. For NPS-RASCAL the CHAR set 
is the ASCII character set. Characters enclosed in 
single quotation marks denote a constant type. 

EXAMPLE: 

TYPE text = CHAR 
VAR text : CHAR 



type INTEGER 



ELEMENT : 

tvoe INTEGER 



FORMAT : 



TYPE t ype- i den t i f i e r = INTEGER . 

VAR variable- identifier : INTEGER 

DESCRIPTION: 

The type INTEGER is an element of a defined subset of 
whole numbers. In NPS-PASCAL the range of integers is 
from -3fe,767 to 36>7fc>6. Arithmetic operators with 
integer operands yield integer values. Relational 
operators with integer operands yield BOOLEAN values. 

EXAMPLE : 

TYPE int = INTEGER 
VAR a » b » c : INTEGER 



type REAL 



ELEMEN r : 

type REAL 



FORMA T : 



TYPE type- identifier = REAL 
VAR va r i ab 1 e- i den t i f i e r : REAL 

DESCRIPTION: 

A value of type REAL is an element of a defined subset 
of REAL numbers. In NPS-PASCAL the ranqe of real 
numbers is expressed in BCD format » 14 decimal digits 

numbers/ multiplied by a corresponding power of ten. 
The exponents of real numbers ranges between -63 and 
64. Inputs may be expressed in exponential form/ or 
real format. Decimal period must be preceded by at 
least one digit. Arithmetic operations using REAL 
. number operands yield REAL value answers. Relational 
operators with real number operands yield BOOLEAN 
values. 

EXAMPLE : 

TYPE re = REAL 
VAR re / i m : REAL 
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type de f . part 



ELEMENT : 

type definition part 



FORMAT : 



TYPE identifier = type {^identifier = typeT 
DESCRIPTION: 

Data types in NPS-PASCAL may be either described in 
the variable declaration part or referenced by a type 
identifier. The type definition allows the creation of 
new types. The definition determines a set of values 
and associates an identifier with the set. 

EXAMPLE : 

TYPE day = ( mon , t ue , wed , t hu , f r i , sa t , sun ) ; 

TYPE color = (red/ white/ blue)/ 

TYPE arry = ARRAY (* BOOLEAN, 1 .. 10 *) OF 

INTEGER 
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unbalanced statement 



ELEMENT : 

unbalanced statement 



FORMAT : 

IF expression THEM statement 
IF expression THEN balanced-statement 
ELSE unbalanced-statement 



DESCRIPTION: 



Unba lanced 


statement 


are a 


form 


o f 


the 




IF 


Condi t i ona 1 


statement 


with an 


equa 1 


numbe r 


o f 


THEN 


and 


ELSE parts. 


This distiction 


was 


needed 


t o 


form 


a 



LALR(l) parsable language. 

EXAMPLE: 

See IF statements and balanced statement. 



variable dec . Dart 



ELEMENT : 

variable declaration oart 



FORMAT : 



VAR identifier {/identifier}: type 

{/identifier {/identifier}}: type 



DESCRIPTION: 



Every variable 


occur i nq 


in a statement 


must 


be 


declared in 


the 


variable 


dec 1 arat i on 


part P r i 


or to 


i t s 


use in the 


program. The 


variable 


dec 1 a r a t 


i on 


pa r t 


assoc i at es 


the 


identifier 


with a data 


type. 







EXAMPLE: 

VAR counter/ 1 ood : INTEGER/ 
errflg : BOOLEAN; 

VAR pi : REAL; 



APPENDIX D NPS-PASCAL LANGUAGE STRUCTURE 



The following section describes the NPS-PASCAL language 
in 8NF notation as moaified to conform with the reguirements 
of reference CIO)# Pascal User Manual , and reference (13), 
User's Guide To The LALR(k) Parser Generator. The 
descriot ion given describes the compiler data structures and 
the code generated. Numbered productions without a 
production result indicate empty productions. Items 
enclosed in brackets and separated by slants are alternative 
semantic actions. This notation is the same as provided by 
references 10 and 13. 



1 <program> = <program heading> <block> . 

* <program heading> <block> 

* ALL ; { number of bytes allocated for variables } 

* ENOP ; { eof indicator } 

2 <program heading> l 1 - PROGRAM <prog ident> ( 

< f i 1 e ident> ) i 

* <program identifier> <file identifier> 

3 PROGRAM <prog ident> ( 

< f i 1 e ident> , < f i 1 e ident> ) / 

* <p roq ram identifier> < f i 1 e identifier> 

* < f i 1 e identifier> 

a <oroq i den t > <identifier> 

N/A 

5 < f i 1 e i d e n t > = <identifier> 

* { enter file identifier } 

6 <block> ::= <ldp> <cdp> <tdp> <vdp> <p fdp> <stmtp> 

* < label declaration part > 

* < constant declaration part > 

* < type declaration part > 

* < variable declaration part > 

* < procedure and function declaration part > 

* < program statement > 

7 < 1 do> : : = 

* < empty > 



1 16 



8 LABEL <label strinq> ; 

* < label strinq > 

9 <1abel s t r i n g > ::= < 1 a b e 1 > 

* < label > / { enter label } 

10 <label string> » <label> 

* < label strinq > < label > enter label } 

11 < 1 abe I > ' i ~ <number> 

* < number > > { check number tyne } 

12 <c dp> : 



* 


< 


emp t y > 




13 




CONST <const 


de f > ; 


* 


< 


constant oef i ni t i on 


> 


14 


<const def> <ident 


const def> 


* 


< 


ioentifier constant 


definition > 


15 




<COnst 


def> J <ident const oef > 


* 


< 


constant oefinition 


> 


* 


< 


identifier constant 


definition > 


16 


< 


ident const def> ::= 


< ident const> = <constant> 


★ 


< 


identifier constant 


> < constant > 


* 


i 


enter constant } 





17 <ident const> <identifier> 



* 


< 


i den t i 


fier > t { enter constant entry } 


18 


<const ant > 


: : = <numbe r > 


* 


< 


number 


> 


; { assign constant attributes > 


19 








<siqn> <number> 


* 


< 


sign > 


< 


number > ; ( set constant attributes } 


20 








<const ant i dent > 


* 


< 


constant 


identifier > { set constant attributes 


21 








<siqn> <constant ident> 


* 


< 


s i gn > 


< 


constant identifier > 


* 


{ 


assign 


constant attributes } 


22 








< s t r i n g > 


★ 


< 


string 


> 


; { assign constant attributes > 


23 


<cons t an 


t 


ioent> ::= <identifier> 


* 


< 


i d e n t i 


fier } 


24 


< s i qn> : 


• — 
• • 




* 


{ 


assign 


SIGNTYPE value > 


25 








- 
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I assign SIGN TYPE value } 



<t -io> : : = 

< emoty > ; i set CASES STMT to FALSE > 



TYPE <type def strinq> ; 

< tyoe aefinition string > { set CASESSTMT FALSE } 



< t y ce def string> <tyoe i d> 

< tyoe identifier > 



<type def st r i nq> ; <type id> 
< type definition string > < type identifier > 



<type id> ::= <type ids> = <tyoe> 
< type identifiers > < type > 

I alter tyoe entry } 



<tyoe ids> ::= <identifier> 

< identifier > 7 { enter type T 

<type> <simple type> 

< s i mo 1 e type > 



<st ructured type> 

< st ructurea type > 

<pointer type> 

< do inter type > 

<simole tyoe> ::= <scalar tyoe> 

< scalar type > 

<subranqe type> 

< subrange tyoe > 

<type ident> 

< type identifier > 

<type ident> ::= <identifier> 

< identifier > ; { set TYPESLOCT > 



< sc a 1 a r type> = ( <tident string> ) 

< tyoe identifier string > 

< t i den t string> <identifier> 

< identifier > 

{ enter tyoe > 



<tident string> » <identifier> 

< tyoe identifier strina > < identifier > 

{ enter tyoe T 

<subrange type> <constant> .. <constant> 

< constant > < constant > ; I enter subrange } 



43 

* 


<structured type> ::= 
< unpacked structured 


<unpac ked 
type > 


st ructured 


t y pe> 


4a 






PACKED 






★ 


< unoacked 


s t r uc t u red 


<unpac ked 
type > 


s t rue tured 


t ype> 


45 


<unpac ked 


st ructured 


t y pe> : : = 


<ar r a y t ype> 





* < array type > 

<recordtype’> 

* < record type > 

^7 <set type> 

* < set type > 

48 <filetype> 

* < file type > 

49 <arr ay type> ARRAY <lp> <index type st r i nq> 

<rp> OF <component type> 

* < Ip > < incex type string > < rp > 

* < component type > ; { enter array type > 

50 < 1 o> : : = C * 

M/A 

5 1 < rp> : : = * ) 

N/ A 

52 < i n d e x type string> : : = < index type> 

* < index type > { set array dimensions > 



53 <index type strinq> » 

< index type> 



* 

★ 


< index type string > < index type > 
{ set array dimensions } 


54 

* 


< i nde x t ype > 

< simple type 


<simole tyoe> 

> 




55 

★ 


<component type> = <type> 

< type > 




56 

* 


< record t ype> 

< field list 


RECORD < f i e 1 d 
> ; { enter record 


1 i st> END 
t ype > 


57 

* 


< f i e 1 d 1 i s t > 

< fixed part 


<fixed oart> 

> 




58 

★ 


< fixed part 


<fixed part> • 
> < variant part > 


<variant part> 


59 

* 


<vari ant part> 

< variant part > 





60 <fixed part> ::= <record section) 

* < record section > 

61 <fixed oart> 7 <record section) 

* < fixed part > < record section > 

62 <recorri section) <field ident string) : <type> 

* < field identifier string > < type > 

* { enter record attributes 1 

63 

* < emp t y > 

64 <field ident st ri ng> <field ident> 

* < field identifier > 

65 <fie1d ident st ri nq> , 

< f i e 1 d ident> 

* < field identifier st ri na > < field identifier > 

66 <field ident> ::= <identifier> 

* < identifier > ; { enter record field > 

67 <variant part) CASE <tag f i e 1 d > <type ident> OF 

<vari ant string> 

* < tag field > < type identifier > < variant string > 

6fi CASE<typeident>OF 

< v a r i ant string> 

* < type identifier > < variant string > 

69 <variant string> <variant> 

* < variant > 

70 <variant string> 7 <vari ant> 

* < variant string > < variant > 

71 <tag field> ::= <field ident> : 

* < field identifier > 7 ( set T A G $ F D to TRUE } 

72 < variant) J! = <case label 1 i s t > t ( < f i e 1 d list> ) 

* < case label list > < field list > 



73 

* < empty > 



74 


<c ase 


label 1 


i s t > 


: : = <case 


label 


> 


* 


< case 


1 abe 1 


> 








75 








<case 


label 


1 1 S t > 9 










<case 


label 


> 


* 


< case 


label 


list 


> < case 


label 


> 


76 


<case 


1 abe 1 > 


• • • 
♦ • * 


<constant> 







* < constant > 
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* ( { set variant attributes } / { set CASES STMT } ) 

77 <set type> ::= SET OF <base type> 

* < base type > } { enter type } 

78 <base type> ::= <simp1 e type> 

* < simple type > 

79 <fii e type> ::= FILE OF <tyoe> 

* < type > ; I enter type } 

80 <po inter type> ::= $ <type ident> 

* < type identifier > ; { enter type I 

81 <vdp> : : = 

* < empty > 

82 VAR <var declar strinq> ; 

* < variable declaration string > 

83 <var declar st ri na> <var dec 1 ar> 

* < variable declaration > 

8a <var declar string> , 

<var dec 1 a r> 

* < variable declaration string > 

* < variable declaration > 

85 <var dec 1 ar> ::= <ident var string> : <type> 

* < identifier variable string > < type > 

* { set variable attributes } 

86 <ident var st r i nq> = <identifier> 

* < identifier > ; { enter variable > 

87 <ident var string> , 

<identi fier> 

* < identifier variable string > < identifier > 

* { enter variable > 



88 <p f dp> :: = 

* < empty > { not implemented > 



89 

* 


<po r f dec 1 a r > 

< procedure or function declaration > 


* 


{ not 


i mp 1 emen t ed 




90 


<po r f 


dec 1 a r > : : = 


<proc or funct> ; 


* 


{ not 


i mpl emented 


> 


91 

* 


{ not 


i mpl emented 


<porf dec 1 ar> <proc or funct> 
> 


92 


<p roc 


or funct> • 


;= <procedure dec 1 arat ion> 


* 


{ not 


implemented 


> 
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<function declaration^ 



93 

* { not imolerrented } 



9a <orocedure oeclaration> 
* { not imolerrented } 



95 <orocedure headinq> 



* 


{ 


not 


i mo 1 em en t ed 


} 


96 










* 


{ 


not 


i mo 1 emen t ed 


> 


97 


< D r o c 


id> ::= PROCEDURE 


* 


{ 


no t 


i mpl err. ented 


> 


98 


< f o rma 


1 para sect 


1 i s t > 


* 


{ 


no t 


i mo 1 emen t ed 


} 



<procedure headi na> 

<b 1 ock> 

<oroc id> ; 

<proc id> ( 

<forma1 oara sect 1 i s t > ) 
< i den t i f i e r> 

<formal para sect> 



99 

★ 


< not 


implemented 


> 


<formal oara sect list 
; <formal para sect> 


100 

* 


<forma1 oara sect> 
{ not imolerrented 


m « * 

> 


<para group> 


101 

* 


{ not 


implemented 


> 


VAR <oara group> 


102 

* 


{ not 


implemented 


> 


FUNCTION <para qroup> 


103 

* 


{ not 


implemented 


> 


PROCEDURE <proc ident list> 


10U 

* 


<p roc 
{ not 


i d e n t 1 i s t > 
implemented 


• • ~ 
• • “ 

> 


<identi fier> 


105 

* 


{ not 


implemented 


> 


<proc ident 1 i s t > > 
<identifier> 


106 

* 


<para 
{ not 


group> Z l- <P a r a 
implemented } 


ident 1 i s t > : <tyoe ident> 


107 

it 


<oara 
{ not 


i d e n t 1 i s t > 
implemented 


# • — 

> 


<identi fier> 


108 

* 


{ not 


i mol errent^d 


> 


<para ident list> » 
<identi fier> 


1 09 


<funct i on dec 1 ar> 




<funct ion heading> cbloc'o 



* { not implemented } 



110 <f unct i on headina> ::= 
* I not implemented } 


< f unc t 


id> : <resul t tyoe> 


1 1 1 


< f unc t 


l d> ( 




< f o rm a ! 


Dara 1 i s t > ) 



: <result t ype> l 

* { not implemented } 

112 < f unc t id> FUNCTION <identifier> 

* { not implemented > 

113 <result tyoe> : : = <tyoe ident> 

* { not implemented } 

114 <stmtp> ;: = <comPound stmt> 

* < compound statement > 

115 < S t m t > ::= <bal stmt> 

* < balanced statement > 

lib <unbalstmt> 

* < unbalancec statement > 

117 <label def> <stmt> 

* < label definition > < statement > 

118 <bal stmt> ::= <if cl ause> <t rue oart> ELSE 

<bal stmt> 

* LBL ; { If Label address2 1 



119 <simplestmt> 

* < simple statement > 

120 <unbal stmt> = <if c 1 ause> <stmt> 

* LBL ; { If Label addressl } 

1 2 1 <if clause> <true oart> ELSE 

<unbal s t m t > 

* L8L ; { If Label address2 1 

122 <if cl ause> : : = < i f > <expression> THEN 

* NOT ; BLC ; { If Label addressl > 



123 <i f> : := IF 
N/A 



124 <true part> :: = <bal stmt> 

* < balanced statement > 

* BRL ; { If Label address2 } 1 LBL ; 

* { If Label addressl ) 

125 < 1 abe 1 def> ::= <label> : 

* < label > J LBL ; i label address > 



123 



12b <s 1 mp 1 e stmt> ::= <ass i gnment stmt> 
* < assignment statement > 
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* 



<procedure stmt> 
< Procedure statement > 



128 

* < 



<repet i t i ve stmt > 
repetitive statement > 



129 <casestmt> 

* < case statement > 

130 <withstmt> 

* < with statement > 



131 

* < 



< read st mt > 

read statement > 



132 <wr i t e stmt > 

* < write statement > 

133 <gotostmt> 

* < goto statement > 

13 a <comPound stmt> 

* < compound statement > 
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* < empty statement > 



136 <assignment stmt> = <variable> : = <expression> 

* < variable > < expression > ; LIT i 

* { variable address > 

* [ STO/STDI/STDB/ ( CNAI/STDB ) ] 



137 <variable> :: = <ent i re vari abl e> 

* < entire variable > 

138 <var i ab 1 e> $ 

* { not implemented } 

139 <variable> <lp> <express 1 i s t > <rp> 

* { not implemented } 



1 ao 



<variab1e> . <field ident> 



* 1 not implemented } 

1 a 1 < e n t i r e variable> <vari able ident> 

* < variable identifier > 

ia£ <variab1e icent> ::= <identifier> 

* < identifier > ; < set variable location/tyoe } 



103 <express 1 i s t > <expression> 

* < not implemented > 



12a 



144 <express list> » <expression> 

* { not implemented 1 

145 <expression> : : = <simple expression> 

* < simple expression > 

146 <simp1e expression) 

<relational operator) 

<simple expression) 

* < simple expression > < relational operator > 

* < simple expression > ! [ EQLI/NEQI/LEQI/GEQI/ 

* LSSI/GRTI/ ( IN not implemented ) /EQLB/NEQB/ 

* LEQB/GEQB/LSSB/GRTB 1 



147 <rel at ional operator) :: 
* { set operator type > 



148 



* { set operator type > 



1 49 



* { set operator type ) 



< > 



< - 
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* { set operator type > 



> : 



151 



* { set operator type > 



152 



* { set 



153 



ope r j 



tor type > 



* { set operator type 1 



IN 



154 < t e r m > <factor> 

* < factor > 



155 



<term> <multiplying operator) <f actor) 



* 


< 


term 


> < muli 


t P 1 y i ng 


operator > 


* 


i 


MULI/MULB/ ( 


CNVI 


9 


CN2I 


; DIVB 


★ 




divi/dc'ri/and 


l ; 


{ 


MOD 


not i mp 1 


156 


< m u 1 t i 


plying ope r a t o r > 


« • — 


* 


* 


< 


set 


operator 


type 


> 
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> 




/ 


* 


{ 


set 


operator 


type 






158 










> 




DI V 


* 


{ 


set 


operator 


type 






159 










} 




MOD 


* 


{ 


set 


operator 


t ype 
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AND 



160 

* { set ooerator type 1 

161 <si mol e expression> <term> 

* < term > 

162 <sign> <term> 

* < sign > < term > ; ( NEGI/NEGB ] 

163 <simDle expression) 

<adoing operator> <term> 

* < simple expression > < adding ooerator > < term > 

* [ ADDI/ADDB/SUBI/SUBR/BOR 1 

160 <adding ooerator> ::= + 

* { set operator type > 

165 

* ( set operator type 1 

166 OR 

* { set operator type 1 

167 <factor> <variab1e> 

* < variable > ; ( LDII ? { interger value >/ 

* LDIB J { BCD real value }/ 

* NEGI/NEGB/LITA ; { variable address 1 

* 10D/L0D I /LODB 1 



168 






<variable> ( <actual para 


* 


{ 


not implemented > 


169 






( <expression> ) 


★ 


< 


expression > 


170 






<se t > 


* 


{ 


not i mp 1 emen t ed } 


171 






NOT <factor> 


★ 


< 


factor > 


; NOT 


172 






<number> 


* 


< 


numbe r > 




★ 


( 


LDII ; { 


integer value > / 


* 




LDIB ; { 


BCD real value > 1 


173 






NIL 


N/A 
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<s t r i na> 


* 


{ 


not implemented } 


175 


<ac t ua 1 para list> ::= <actual para> 


* 


{ 


not implemented > 
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176 



<actual oara 1 i s t > 
<actual para> 



f 



* ( not i nol emented } 

177 <set> tt = <lp> <e 1 emen t 1 i s t > <rp> 

* { not implemented > 

178 <element list> ::= 

* < empty > 

179 <xelementlist> 

* 1 not implemented 1 

180 <*element 1ist> <element> 

* { not implemented } 

101 <xelement list> t <element> 

* { not implemented > 

182 <element> : : = <expression> 

* 1 not implemented ) 

103 <expression> .. <expression> 

* { not implemented } 

18a <goto s t m t > <qoto> <label> 

* < goto > < label > 

* { 1 abe 1 address > 

185 <qoto> ::= GOTO 

* BRL 

186 <compound stmt> : : = <begin> <stmt lists> END 

* < begin > < statement lists > 

187 <begin> ::= BEGIN 
N/A 

188 < s t m t 1 i s t s > ::= <stmt> 

* < statement > 

189 <stmt lists> 7 <stmt> 

* < statement lists > < statement > 

190 <procedure stmt > :t = <procedure ident> 

* { not implemented } 

191 <procedure ident> ( 

<actual oara list> ) 

* { not implemented } 

192 <procedure ident> < i den t i f .i e r > 

* { not implemented > 

193 <actual para> :: = <expression> 
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{ not i mp I err en t ed } 



* 



19a <rec variable list> :: = <variable> 

* < not idiol erented } 

195 <rec variable list> > 

< v a r i ab 1 e > 



* 


{ not 


imolerr. ented } 


196 


< read 


S t m t > 


t : = < read head> ( 


* 


< read 


head 


> < i o list > 


197 


< read 


h ead> 


::= READ 



* { set IWRITESSTMT to FALSE 1 

* { set ALLOCATE to FALSE ( don't skio to new line) > 

198 READLN 

* { set WRITESSTMT to FALSE > 

* { set ALLOCATE to TRUE ( skip to new line ) ) 

199 <write stmt> = <write head> ( <io list> ) 

* < write heao > < io list > 

* 1 if ALLOCATE then DUMP 1 

300 <wr i te head> 

* < write heao > 

* f i f ALLOCATE then DUMP ) 

201 <write head> : : = WRITE 

* { set WRITE- 1ST M T to TRUE > 

* { set ALLOCATE to FALSE } 

202 WRITELN 

* < set WRITESSTMT to TRUE > 

* { set ALLOCATE to TRUE > 

203 <io 1 i s t > ::= < f i l e ident> * > <var 1 i s t > 

* { not i mp 1 enr en t ed > 

20a <var 1 i st > 

* < variable list > 



205 < va r 1 i s t > ::= <variable> 

* < variable > J l WR V I /WR VB/RDV I /RD VB 

* ( STDI/STDB - read statements only ) 1 

206 <strinq> 

* < string > ? WR V S > I string ) 

* { write statement only } 

207 <var 1 i s t > , <variable> 

* < variable list > < variable > 

* [ WRVI/WRVB/RDVI/RDVB ( STDI/STDB - 

* read statement only ) 1 
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208 <var list>»<string> 

* < variable list > < string > 

* flRVS J { string } ( write statement only ) 



209 <case stmt> <case express> 

<case list elect 1 i s t > END 
*{ not implemented} 

210 <case express> ::= CASE <exoression> OF 

* { not implemented } 

211 <case list elemt 1 i s t > <case list e1emt> 

* { not implemented } 



212 



<case list elemt 1 i s t > 
<case list e1emt> 



★ 


{ not i m p 1 ennen t ed 


> 




213 


<case list elemt> 


II 
• • 
• • 




* 


< emo t y > 






219 






<case label list> : <stmt> 


★ 


{ not i mpl emen t ed 


> 




215 


<reoetitive s t m t > 


• • 


<while stmt> 


* 


< while statement 


> 




216 






<reoeat s t m t > 


* 


< reoeat statement > 




217 






<for stmt> 


* 


< for statement > 






218 


<with s t m t > ::= <witH> <rec variable list> <do> 




<ba 1 


Stmt > 


* 


{ not implemented 


> 




219 


<with> ::= V'* I T H 






* 


{ not i mol ement ed 


> 




220 


<do> : : = DO 






* 


{ not implemented 


} 




221 


<while stmt> 


<wh i 


le> <expression> <do> 






<ba 1 


s t mt > 


* 


{ not imolemented 


> 




222 


<wh i 1 e> : : = WHILE 






* 


{ not implemented 


} 




223 


<f or stmt> •*- <for> 


<control vari abl e> : = 




<f or 1 


ist> <do> <ba1 stmt> 


* 


{ not implemented 


} 




229 


< f or> : : = FOR 
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{ not implemented } 



* 

225 < for 1 l s t > ::= < initial 1 i s t > <to> <final v a 1 u e > 

* { not imolerrented > 

226 < i n i t i a 1 val ue><downto> < f i n a 1 v a 1 u e > 

* { not implemented } 

221 < c on t r o 1 v a r i a b 1 e > ::= <identifier> 

* { not imolerrented > 

228 <initial val ue> <expression> 

* { not imolerrented } 

229 <final value> <expression> 

* { not imolerrented } 

23 0 <repeat stmt> <reoeat> <stmt lists> < u n t i 1 > 

<express i on> 

* < reoeat > < statement lists > < until > 

* < exoression > ; NOT ; 8LC ; { set REPEAT SLBL } 



231 


<repeat> REPEAT 


* 


LBL ; 


{ repeatslbl 


232 


< u n t i 


1 > : UNTIL 


N/A 




233 


< t o > 


: := TO 


* 


< not 


implemented } 


23a 


<down t o> D0WNT0 


* 


{ not 


implemented ) 
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NPG- PASCAL 



PROGRAM LISTINGS 



*100h: 



/*load point for compiler^/ 



/##* system literals *** 



dec lare 



lit 1 i tera 1 ly 


’ 1 i tera 1 ly’ 


cr 


lit 


’ 13’ , 


If 


lit 


’ 0ah’ , 


dc 1 


lit 


’ dec lare ’ , 


pos 


lit 


’0’ , 


neg 


lit 


’ 1’ . 


tab 


l i t 


’ 09h’ , 


proc 


lit 


’ procedure ’ 


bdos 


lit 


’ 5h’ , 


boo t 


lit 


’0’ , 


true 


lit 


* 1* , 


addr 


lit 


’ address ’ , 


minusx 


lit 


’ 2dh’ , 


r f i le 


lit 


’20’ , 


false 


l i t 


’0’ , 


max in t 


lit 


’32767’ , 


beds ize 


lit 


’8’ , 


ands ign 


lit 


’ 26h’ , 


f i leeo f 


lit 


’ r • 


eo lchar 


lit 


’Odh’ , 


maxSnes t 


lit 


’3’ , 


forever 


lit 


’while true 


c o mme n t 


lit 


’0’ , 


varcs ize 


lit 


’ 100 ’ , 


has hmask 


lit 


’ 127’ , 


f ormmask 


lit 


* 7 ’ , 


typeSentry 


lit 


’2’ , 


varOentry 


lit 


’3’ , 


typeSdc le 


lit 


’7’ , 


typemask 


lit 


’00 11 1000b’ 


con tchar 


lit 


’ 5ch’ , 


codes ize 


addr 


, /* 


ident s ize 


1 i t 


’32’ , 


eo f f i 1 ler 


lit 


’ lah’ , 


s ta tes ize 


lit 


’ address ’ , 


indexs ize 


lit 


’ address ’ , 


ps tacks ize 


lit 


’48’ , 


f i rs 1 0 1 ime 


byte 


initial ( 


ident i f ier 


lit 


’62’ , 


intrecs ize 


lit 


’ 128’ , 


f i leGentry 


lit 


’6’ , 


lab ISentr y 


lit 


’0’ , 


cons Gentry 


lit 


: ’ 1 * • 


maxoncoun t 


lit 


’25’ , 


conbuf f s ize 


lit 


’82’ , 


s t r ingde 1 im 


lit 


’ 27h’ , 


bnshtb Is ize 


lit 


’ 128’ , 


ques t io ninar k 


lit 


’ 3f h’ , 


maxOnmnOar r ySd imen lit ’5 , 


arryGnes t 


1 i t 


’ 4 ’ , 



/Gentry point to d is! 
/* exit to return to 



. op 
op. 



s ys '.'/ 
sys . # 



used to count size of code area 



/* stack size for parser */ 



consS i den tG type lit * 1’, 
consGs identSt ype lit *2’ 
sourcerecs ize lit ’128’; 



/% number types */ 
del ordGtype lit 
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del 



dc 1 



c harO t ype 


lit 


’2’ , 






int egerC type 


lit 


’ 1* , 






r ea 10 type 


lit 


’2’ , 






uns i g-nOexpon 


lit 


’3’ , 






s ignedOexpon 


1 i t 


’4’ , 






c o mp 1 e xO t ype 


lit 


’4’ , 






s tr ingO type 


lit 


’ 4 * , 






boo leanO type 


lit 


’ 5 ’ , 






s igntype 


byte 


i 






cons tO type 


byte 


; 


type of constant %/ 


max mo 


lit 


’ 192’ , 




max read count '£/ 


max 1 no 


lit 


*251’ , 




max look count '£/ 


maxpno 


lit 


’ 276 1 , 


/* 


max push count 


maxs no 


lit 


’510’ , 


/* 


max state count %/ 


s tar ts 


lit 


’ 1\ 


/% 


start state 


prodno 


lit 


*234’ , 




number of product i< 


eo f c 


lit 


’25’ , 


/* 


eo f 


number c 


lit 


’58’ , 


/* 


number 


s tr ingc 


lit 


’59’ , 




s t r i ng 


termno 


1 i t 


’62’ ; 


/* 


terminal count 



sb loc 
form 
expon 
ve c p t r 
1 ineno 
typonum 
r f ebaddr 
cons top tr 
s tar tbdos 
lab lcoun t 
max 

crrorcount 
typeCaddr 
t ypeC lo c t 
varCptr 
varG type ( 10) 
va r Os isTi( 10) 
expo t ype (11) 



addr 
byte , 
byte , 
byte , 
addr , 
byte , 
addr 
byte , 
addr 
addr 
based 
addr 
addr , 
addr , 
byte , 
byte , 
byte , 
byte , 



in i t ia 1 ( 80h) 



initial ( 5ch) , 

ini t ia 1 ( 6h) , /^addr of 
initial(O) , number 

startbdos addr, 
initial (0), 



e xpG iypeOaddr ( 11) addr, /* 
expOptr byte initial 



type of expression 
addr of scalar 
(0) , 

opOtype( 10) byte, 

opCptr byte initial (0), 

caseCsimt byte initial (false), in 

writeOstmt byte initial (false), in 

repea tG lb 1 ( 10) addr, 

repeatOptr byte initial (0), 

allocate byte, true or false 

a 1 lcCbas icO t ype byte, 

arryOqty( maxOnusnOar ryGd imen) addr, 

varObase( 10) addr, 

varObas e 1(10) addr, 



t ypeO indx 
a 1 IcOqty 
typef o r m 
a 1 locSaddr 
t ype Cor dOnum 
parentG type 
cons tS indx 
lookupOaddr 
cons t ovec ( 4) 
cons tCva lue ( 162) 
cons t GpnChas h( 4) 
cons tOpnOp tr 



byte , 
addr , 
byte , 
addr 
byte , 
addr , 
byte , 
addr , 
byte , 

byte , 
byte , 
byte , 



initial (0) 



cons tOpnOs ize ( 4) byte, 
integerSdiff addr, 
subr0val(2) addr, 
subr0type(2) byte, 
subrSptr byte, 
s ubrG typeOaddr addr, 
subrOforra byte, 



ptr to top of bdos 
o f labe Is us e d */ 



parent type 



case s tmt 
write stmt %/ 
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del 



ini t ia 1 ( 255) , 

if s ta teraent 



subrSpnOs ign byte, 

arryGbase addr, 

arryCptr byte, 

arryGd imOp tr byte, 

ptrptr byte, 

ifOptr byte 

ifClbl(l) addr, 

t agOf d ( maxOnes t ) byte 

varOcasG tp( maxOnes t ) addr, 
varScasSva 1 ( masOnes t) addr, 
recOvarO typ( maxOnes t ) byte, 
recOnst byte initial (255), 

recordOptr byte , 

recOaddr(6) addr, 

recOparOadr ( maxOnes t ) addr, 
var iantOpar t ( maxOnes t ) byte, 

fxdOo fs tGbse ( masOnes t ) addr, 
varOo f g tObse ( maxOnes t) addr, 
curGo f 3 t ( maxOnes t ) addr, 

numOarryCd imen( inaxOnumOarryOd imen) byte , 
a rryOd imen( 25 ) addr, 
aryOdmOadrSp tr byte, 
cons tOnumO type (4) byte, 
bcdnum(bcdsize) byte, 



stack X/ 



r f cb 
no look 
1 inep tr 
buf f p tr 
wfcb( 33) 
sourceptr 
no int f i le 
sourcebuf f 
produc t ion 



based 

byte , 

byte 

byte 

byte 

byte 

byte 

based 

byte , 



rfcbaddr (33) byte, 



initial 
initial 
initial 
initial 
initial 
sb loc 



(0) , 
(255) 
< 0 , • 



prvGsb t b lSentry addr, 
cursourcerecsise byte initial 
1 inebuf f ( conbuf f s ize ) byte, 
d iskoutbuf f ( in trees ize ) byte; 



( sourcerecs ize ) 
(fa lse ) , 

( sourcerecs ize ) 



(sourcerecs ize) 



’ pin’ , G, 0, 0, 0) , 



byte , 



ini tCsymbOtb 1 data(0,0,0, 0, 42h, 7 , ' i* , ' n' , ' t' , * e' f ' g' t * e * t 

* r 1 ,0,0,O,0,4ah,4, , r*, , e , , , a , ,’l’ , 0 , 0 , 0 , 0 , 52h, 4 , 1 c ’ , * V , ’ a ’ , 
*r f , 0 , 0 , O , 0 , 5ah, 7 , , b , , , o f l ’o’,M , , , e’,*a , , , n’ , 0 , 0 , 0 , 0 , Oeh, 
5,’ i * , ’ n* , ’ p * , *u*, * t ’ ,0,0, 0,0, leh, 6 , ’o , , , u , ,’t , ,’p’, , u , ,’t* f 
0 , 0 , 0 , 0 , 09h, 4 , *t’,’r’,*u*,’e* , 0 , 0 , 0 , G , 0 , 0 , 0 , 0 , 09h, 5 , ’f'/a’, 
’ 1’ , ’s’ , *e’ ,0,0, 1,0) ; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 
/XXX scanner global variables *** 

/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
/ XXXXXXXXXXXXXXXXXXXXXXX^tCXXXX'f+XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
del token byte, /X type of token Just scanned X 

hashcode byte, /X has value of current token X 

nextebar byte, /^current character fm getchar^ 

cont byte, /*indx full accum. still more X 

accum( idents ize ) byte; /X holds current token X/ 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
/XXX symbol table global variables XXX 
/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

/^XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 



dc 1 



base addr, 

hashtab le(hashtbls ize) 
sbtbltop addr , 

sbtbl addr, 

ptr based base byte 

aptraddr addr, 

addrptr based aptraddr 
byteptr based aptraddr 



addr , 



/X util 
addr , 
byte , 



Abase of current entr 

/^current top of table 

/X 1st byte of entry 
1 ty variable to access 





X/ 


( sym) 


X/ 




X/ 


table 


X/ 
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pr in t name 
symhash 



addr , 
byte ; 



set prior to lookup or enter 






declare readl da ta( 0 , 56 , 25 , 12 , 14 , 62 , 62, 34 , 60 , 6 1 , 62 , 59 , 62 , 62 , 1 1 8 3 3 13 

,62,62,62,62,62,59,62,59,62.14,3,4,9,58,59,62,3,4 5,9,33 37 43 51 3 
,58, 59, 62, 3, 4, 9. 58. 59, 62, 3, 16, 31, 32, 58, 59, 62. 22:62, 62:62:3, 4?9 16 3 
,32,58,59,62,22,62, 16,62,58,33,37,43,53,35,62,62,62,62,62,20,29 35 
,33,39,42,44,48,49,52,54,57,62,22,41,62,45,34,60,61,58,62,6, 10 *>6 0 
,30,62,20,29,35,38,39,42,44,48,49,52,54,57:58:62:1, 13,44,7:7,3 8 i5 

,3, 13, 14, 11, 1,5, 16, IS, 1,3,5, 16,8,3,36,36,22,40, 19,7, 15,28,7,7, ih?, 

,8,3,8,28, 8,47, 22,22,3, 1 1 , 17, 13, 14,8, 8, 17, 8, 1 1 ,24,50,8,8, 7, 1 1 , 1 1 ,8 

, 11, 13, 11, 13, 11, 13, 11,3,46,8,7, 11,7, 11, 18, 11, 13, 11, 17, 11, 19,2,4 9 1 
, 14,21,23,4,9,23,8, 11, 13,8,28,7,8,7,8,0,0,0,0,0) ; 



declare lookl da ta( 0 , 12 , 14 , 0 , 33 , 62 , 0 , 62 , 0 , 62, 0 , 62 , 0 , 35 , 62 , 0 , 8, 28, 47 , 0 8 

,28,0,7,8,28,0,14,8,8,23,0,7,8,28,0,7,8,28,0,8,28,36,47,0,36,0,35:6 
,0,15,0,1,5,16,18,0,13,0,6,9,0,0,0,17,0,41,0,45,0,34,0,44,0,6,10,26 
,27,30,0,6, 10,26,27,30,0,6, 10,26,27,38,0,8,28,0,8,47,0,36,0, 11,0, 11 

, 0, 1 , 3,5, 16,0, 1 1 , 19, 0,7, 1 1 , 0, 1 1 , 19,0,7, 1 1 ,0,8,28,36, 47,0, 36,0,8, 23 

,47,0,15,0,8,0,3,0.44,0,8,23,0,11,0,0,0,8,0,11,0,3,0,46,0,46,0,46,0 

,2,4,9, 12, 14,21,23,0,4,9,23,0) ; 



declare apply 1 data (0,8, 0,0, 5, 30,0, 179, 182,0,0,0,29,75,97,0,0,0,21,0,0 
,27,28,37,52,54,60,62, 158,0,98,0,27,28,35,37,45,47,52,53,54,58,59,6 
,61,62,87, 158,0,0,0,22,0,0,45,47,59,61,0,35,58,87,0, 15,46,48,50,67 
, 132,0,0,0,0,0,76,0,0,73, 121, 122, 123, 124, 125, 126,0,152,159,0,0,35,0 
,0,0,14,0,0,24,0,0,3,33,67,0,24,0,62,0,0,28,0,27, 153,0,37,0,0,0,0,0 
,0,0,23,0,0,0,0,155,0,0,0,0,8,0,26,0,0,66,80,0,0,0,0,0,50,0,0,25,49 
, 128, 130,0,69,70,83,84,85, 123, 129,0,69,0,70,83,84,85, 129,0,0, 129,0, 
,0,0,10,11,25,36,41,43,49,69,70,83,84,85, 103, 104, 111, 128, 129, 130,0, 
,0,0,9,39,40,55,56,57,68,86,83,89,91, 108, 109,110,0,0,99,168,0,0,188 
,0,0,63, 190,0, 13,0,0,0,0,39,0,0,0, 107,0,0, 111,0,0,0,42,0,0,0,0,0,0 
,11,0,43,0,0,0,0,27,0,0,0,0,116,137,0,0,0,0,0,0,0,0,110,0,0,0,0,0,0 

) i 



del read2(236) addr initial 

(0,78, 277 , 424 , 425 , 28 1 , 3 16 , 66 , 80 , 32 , 383 , 482 ,212,314,43 
, 278 , 279 , 372 , 50 , 363 ,317, 342 , 384 ,381, 484 ,413, 482 .418, 426 , 194 , 300 , 30 1 
, 294 ,293,299,6, 300 ,15,301,64,71,73,76, 208 , 294 , 298 , 209 , 6 , 300 , 30 1 , 294 
, 298,209 , 9 , 325 , 449 , 63 , 448, 450 ,418,53, 362 , 383 ,211,9, 300 ,301, 326 , 449 
, 63 , 448 , 450 ,418,39, 307 , 326 , 293 , 2S7 ,64,71,73, 208 , 67 , 342 , 280 , 383, 373 
, 380 , 399 , 500 ,68,461, 473 , 495 , 463 , 498 , 477 , 474 , 507 , 478 ,210,61,72, 503 , 7 
,65,79,31,295, 299 , 432 , 433 , 436 , 434 , 435 ,418, 399 , 500 ,68,461, 473 , 495 , 46 
,498,477,474,507,478,237,210,2,401,463,472,475,7,371 ,34,8,46,53,41, 
,414,326,56,3, 13,414,326, 195, 10,206,207,486,398,496,445,55,332,348 
, 17,30, 33, 16, 193,5, 199,462, 199,508,204,205, 11,40,327,347,52,386,387 
, 327 , 284 , 29 , 509 ,510, 366 , 367 ,315,32,39,201,37, 203 , 37 , 5 1 , 34 , 48, 38, 12 
,75,196, 467 , 42 , 444 ,42,57,31,45,35, 327 ,36,496,193, 440 ,441, 202 , 423 , 42 
,442,440,441,442, 197,33,47,200,485, 19 , 26 , 20 , 26 , 0 , 0 , 0 , 0 , 0) ; 

del 1 oo!l 2(171) addr initial 

(0,4,4, 427 ,14,14,252,21, 289 , 22 , 303 ,23,358,24,24,253 
, 254 , 254 , 254 , 25 , 255 , 255 ,27,256,256, 256 ,28,44, 428 , 257 ,257,49, 258 , 258 
,258,69,259,259,259,62,260,260,260,260,69,261,70,77,77,262,299,314 
,418,418,413,418,468,342,314,231,418,83,84,85,263,88,92,264,94,265 
,95,266,267,96, 100, 100, 100, 100, 100,437, 10 1 , 10 1 , 10 1 , 10 1 , 101,438, 102 
, 102, 102, 102, 102,439,268,268, 104,269,269, 111,400,391, 119,480, 120,47 
,122, 122, 122, 122,443,470,470, 123,481,481, 124,471,471, 125,483,483, 12 
,270,270,270,270, 128,271, 129,272,272,272, 130, 139,458, 145,333, 151,47 
,365, 155,273,273, 158, 165,455, 166,344, 167,343, 172,379, 173,466, 174,27 
, 179,275, 182,276, 184, 184, 184, 184, 184, 184, 184,421, 185, 185, 185,422) ; 

del apply2(273) addr initial 

(9,0,247, 146, 142, 143, 144,385,370, 105,218, 160,286,285 
,460, 106,217, 127,291,290, 154,352,352,352,292,318,352,352,352, 115,29 
,296,93,98,98,98,98,98,93,98,98,98,98,98,98,98,98,98,99,219, 175,305 
, 304, 1 18,361,338,355,331 ,306,330,354,330,308,356,389,382,389 ,149,15 
,313,311,164,312, 309 , 320 ,319,321,87,89,89,89,89,89,89,216,415,453,9 
,181 ,329,328,325,322, 141, 140,233,337,336, 187,416,341, 153,340,334,33 
,244,243, 132,346,345, 169, 169, 170,351,350,323,353,324,310,220, 186,36 
,359, 180, 107,240, 163, 162,368,249, 114,192, 191,375,374,245,377,378,37 
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, 171 
* 226 
,231 
, 121 
, 137 
, 159 
, 131 
,213 



,369, 
, <103 , 
,231, 
,229, 
,505, 
,242, 
,403, 
,491, 



24S , 
391, 
121 , 
413, 
469 , 
457, 
239, 
139, 



117 

397 

232 

417 

183 

456 

113 

493 



, 157 
,392 
,233 
, 152 
,222 
,409 
, 1 12 
,93, 



, 156,232,465 
,235,235,235 
,231, 121, 121 
, 133,237,420 
,223,221, 190 
,97,390,410, 
,223,227,405 
116, 173, 161 , 



,490,396,393,464 

,235,235,234,36, 

, 121 , 121 , 121, 121 
,459,412,504, 135 
,251,250, 168,447 
224, 148, 147,403, 
,241, 139,488,487 
502,501,492,225, 



,394,394 
134, 133, 
,230, 121 
, 136,237 
,431,430 
246,452, 

, 404 , 406 
108,91 , 1 



,494,497,49 
236,395,402 
, 121 , 121 , 12 
,419,505,50 
, 177, 176,44 
451, 183,407 
, 103,215,21 
10) ; 



del indeicl(511) addr initial 

( 0 , 1 , 2 , 21 , 0 , 5 , 6 , 7 , 7 , 64 , 11 , 11 , 64 , 64 , 82 , 13 , 14 , 15 , 16 , 17 
, 18 , 76 , 74 , 61 , 82 , 116 , 7 , 00 , 30 , 77 , 5 , 19 , 20 , 21 , 22 , 47 , 115 , 30 , 23 , 64 , 64,24 
, 64 , 26 , 23 , 35 , 13 , 30 , 18 , 116 , 13 , 29 , 30 , 35 , 30 , 64 , 64 , 64 , 47 , 35 , 30 , 35 , 30,53 
, 60 , 61 , 62 , 63 , 64 , 88 , 83 , 73 , 74 , 75 , 76 , 77 , 78 , 82 , 84 , 85 , 62 , 86 , 87 , 88 , 88,88 
, 64 , 47 , 64 , 64 , 101 , 64 , 102 , 103 , 104 , 105 , 106 , 77 , 108 , 53 , 110 , 110 , 110, 115 
, 116 , 130 , 131 , 132 , 64 , 64 , 64 , 116 , 133 , 134 , 135 , 137 , 156 , 138 , 140 , 141, 141 
, 142 , 146 , 142 , 142 , 142 , 142 , 150 , 116 , 83 , 116 , 151 , 13 , 152 , 153 , 154 , 155, 156 
, 157 , 158 , 159 , 160 , 161 , 163 , 364 , 165 , 166 , 167 , 169 , 171 , 172 , 173 , 174 , 176,17 
, 106 , 173 , 179 , 30 , 130 , 131 , 183 , 185 , 186 , 187 , 389 , 190 , 190 , 53 , 191 , 193, 195 
, 197 , 193 , 199 , 200 , 201 , 203 , 205 , 199 , 206 , 203 , 199 , 210 , 212 , 219 , 222 , 223,64 
, 225 , 53 , 227 , 229 , 1 , 4 , 7 , 9 , 1 1 , 13 , 16 , 20 , 23 , 27 , 29 , 32 , 36 , 40 , 45 , 47 , 50 , 52 , 5 
, 59 , 61 , 62 , 63 , 64 , 66 , 63 , 70 , 72 , 74 , 80 , 86 , 92 , 95 , 93 , 100 , 102 , 104 , 109, 112 
, 115 , 113 , 121 , 126 , 123 , 132 , 134 , 136 , 138 , 140 , 143 , 145 , 147 , 149 , 151 , 153 , 15 
, 157 , 159 , 167 , 339 , 339 , 411 , 489 , 349 , 411 , 349 , 349 , 411 , 411 , 339 , 454 , 302 , 28 
, 357 , 364 , 411 , 411 , 411 , 411 , 411 , 489 , 283 , 203 , 283 , 1 , 2 , 2 , 3 , 4 , 7 , 10 , 10 , 1 1 , 1 
, 12 , 16 , 16 , 17 , 17 , 18 , 20 , 21 , 21 , 21 , 21 , 21 , 30 , 32 , 32 , 49 , 49 , 50 , 50 , 51 , 53,54 
, 54 , 54 , 59 , 59 , 59 , 63 , 70 , 71 , 71 , 72 , 73 , 73 , 74 , 74 , 74 , 74 , 76 , 77 , 35 , 88 , 88,89 
, 91 , 92 , 93 , 93 , 93 , 95 , 95 , 96 , 96 , 98 , 93 , 99 , 103 , 103 , 105 , 105 , 107 , 103 , 103, 11 
, 110 , 113 , 115 , 116 , 117 , 113 , 119 , 119 , 120 , 120 , 121 , 123 , 123 , 124 , 124 , 125 , 12 
, 126 , 125 , 123 , 129 , 129 , 130 , 131 , 131 , 133 , 133 , 133 , 133 , 135 , 135 , 136 , 139, 13 
, 148 , 141 , 141 , 142 , 143 , 145 , 146 , 146 , 146 , 151 , 151 , 139 , 159 , 161 , 167 , 168, 17 
, 171 , 171 , 171 , 171 , 171 , 171 , 171 , 171 , 171 , 171 , 172 , 173 , 173 , 173 , 173 , 192, 19 
, 194 , 194 , 195 , 195 , 210 , 210 , 210 , 210 , 210 , 210 , 210 , 211 , 211 , 214 , 214 , 214,21 
, 214 , 215 , 215 , 215 , 217 , 217 , 217 , 218 , 218 , 218 , 218 , 218 , 218 , 213 , 218 , 221,22 
, 223 , 224 , 224 , 225 , 225 , 226 , 226 , 228 , 229 , 230 , 232 , 233 , 233 , 235 , 235 , 236 , 23 
, 239 , 239 , 240 , 241 , 241 , 242 , 242 , 243 , 243 , 244 , 244 , 246 , 246 , 246 , 246 , 248 , 24 
, 250 , 250 , 251 , 251 , 253 , 253 , 253 , 254 , 255 , 256 , 259 , 260 , 261 , 262 , 263 , 263,26 
,265,256,268,269,270,271,272); 



dec lare indez2 da ta< 0 , 1, 1, 1,2, 1, 1,4, 4, 9, 2, 2, 9, 9, 2, 1, 

, 4, 5, 5, 1, 1, 1, 1,1, 1,6, 1,5, 1,9, 9, 2, 9, 2, 1,22,1, 12, 1 
,6, 12,5, 12,5,7, 1, 1, 1, 1,9, 13, 13, 1, 1, 1, 1, 1,4,2, 1, 1 
,9, 9, 1,9, 1,1, 1,1, 2, 1,2, 7, 5, 5, 5, 1,14, 1,1, 1,9, 9, 9, 

,4, 4, 3, 3, 3, 3, 1, 14, 13, 14, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,2, 

,1,1, 2, 1,1, 5, 1,2, 2, 1,1, 2, 1,1, 1,7, 2, 2, 2, 1,1, 1,1, 2 
,2, 9, 2, 7, 2, 2, 3, 3, 2, 2, 2, 3, 4, 3, 4, 2, 3, 4, 4, 5, 2, 3, 2, 5 
,6, 6, 6, 3, 3, 2, 2, 2, o,3, 3, 3, 3, o,2, 4, 2, 2, 2, 2,3, 2, 2, 2 
, 25 , 27 , 23 , 49 , 60 , 62 , 69 , 70 , 77 , 88 , 92 , 94 , 95 , 96 , 104 , 1 
, 174, 179, 182,3,5,7,0,0,5,0,2,0,2,0,0,2,0,2,2,0,0 
,2, 2, 0,0, 0,0, 0,0, 0,0, 2, 0,2, 2, 0 , 1 , 0,0, 0,0, 5, 0,0,0 
,0,0, 2, 0,4, 3, 0,2, 1,4, 0,0, 2, 0,2, 0,2, 1,0, 2, 0,2, 2,0 
,1,0, 2, 0,1, 1,1, 0,2, 2, 0,2, 1,3, 6, 1,0, 0,0,0, 1,3, 0,1 
,0,0, 0,0, 0,2, 0,1, 3, 2, 0,0, 0,2, 0,2, 0 , 1 , 1,1, 0,0, 0,0 
,0,0, 0,3, 2, 0,1, 0,0, 0,0, 2, 2, 0,0, 0,2, 0,2, 1,0, 2, 0,0 
,3, 0,0, 0,3, 0,0, 0,2, 2, 2, 2, 0,2, 0,2, 0,0, 0,3, 0,0, 3,0 
,0,0) ; 

global procedures *** 



1, 1 
, 14 
, 1 , 
14, 
1, 1 
, 2 , 
O 

i “ t 

9 

IT! 

, i, 
, 2 , 
i 2 , 

, 3 , 
, 2 , 
,2, 
,5, 



, 1 , 1 , 1 , 1 , 1 , 1 , 2 , 1 
,1,1,5, 12,3,9,9, 
1, 1, 13, 13, 13,9,6 
1, 1,2, 1, 1,2, 1, 1, 

, 1 , 1 , 2 , 2 , 1 , 1 , 1,2 
1, 1,2,2, 1,2, 7, 3, 
2,1,1, 1,2, 2, 2, 2, 
2, 2, 2, 2, 8, 4, 14,2 
128, 129, 130, 153 
0 , 1 , 0 , 0 , 0 , 0 , 0 , 2 , 
0,0, 2, 0,2, 0,0, 2, 
0,0, 1,2, 0,0, 1,1, 
2 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 
0,0,0, 0,0,0, 1,2, 
0,3, 0,0, 0,2, 3,0, 
0,2, 2, 0,0, 0,3,0, 



monl : proc ( f , a) ; 

del f byte, 

a addr; 
go to bdos ; 
e nd mo n 1 ; 



mon2: proc (f,a) byte; 
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del f byte, a addr ; 

go to bdos ; 
end mon2; 



mon3 : proc ; 

SO to boo t ; 
e nd mo n3 ; 



/*used to return to the system* 



move *• proc (a,b,l); 

del (a,b) addr, 

(s based a, d based 
do while ( 1 : = 1 - 1) 
d = s ; 



end 



b = b + 
a = a + 
end ; 
move ; 



1; 

1; 



b , 1 ) byte ; 
<> 255; 



/Amoves fm a to b for 1 bytes * 
/* 1 < 255 bytes 



fill: proc ( a , char, n) ; /* move char to a n times */ 

del a addr ,( char , n, des t based a) byte; 
do while (n := n-1) <> 255; 

dest = char; 
a = a + 1 ; 
end ; 

end fill; 



read : proc ; 

del toggle(3) byte; 
toggle = 1; 

call monl ( 10 ,. toggle ) ; 
end read; 



printchar : proc(char); 
dc 1 char byte ; 

call mon 1 ( 2 , char ) ; 
end pr intchar ; 



pr int : proc ( a) ; 

del a addr ; 

call monl ( 9 , a) ; 
end print; 



d iskerr • proc ; 
do ; 

call print(.*de O’); 

5 go to boo t ; 

end ; 

end d iskerr; 

se t upO int Of i le : proc ? 

if nointfile then only make file if this toggle off */ 

re turn; 

call mo ve ( . r feb , . wf cb , 9) ; 

wfcb(32) = 0; 
call mo n 1 < 1 9 , . wf c b ) ; 
if mon2( 22, . wfeb) = 255 then 
call d iskerr ; 
end se tupSintOf i le ; 

wr i teO int Of i le J proc; 
if nointfile then 
re turn; 

call monl(26, .diskoutbuf f) ; 
if mon2( 2 1 , . wf cb) <> 0 then 
call d iskerr ; 
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call mon 1 ( 26 , 80h) ; /* reset dma addr */ 
end wr i teG in t Of i le ; 

emit: proc ( obj code ) ; 
del objeode byte; 

if (buffptr := buffptr+1) >= intrecslze then 
/% write to disk 
do ; 

call wr 1 teG intOf i le ; 
buffptr = 0; 
end ; 

d i s ko utbuff( buffptr) = objeode; 
end emit; 

generate: proc ( objeode) ; 
del objeode byte; 

codesize = codes lze+1; 
call emi t ( objeode ) ? 
end genera te ; 

c loseG intSf i le : proc; 
closes a file 

if mon2( 16 , . wfeb) = 235 then 
call diskerr; 
end c loseS in tGf i le ; 



openOsource f i le : proc; 

call mo ve ( . * pas * , r f cbaddr+9 , 3) ; 
r fcb( 32) , r f cb( 12) = 0; 
if mon2( 15 , r febaddr ) = 255 then 
do ; 

call print(.*no source file S’); 
go to boot; 
end ; 

end openOsource f i le ; 

rewindOsourceOf i le : proc ; /% cp/m does not require any action 

return; prior to reopening 

end re windOsourceOf i le ; 



readOsourceOf i le : proc byte; 
dc 1 dent byte ; 

if ( den t : =mon2( rf i le ♦ r febaddr ) ) > fileeof then 

call d iskerr ; 
return dent; 
end readOsourceOf i le ; 



cr 1 f : proc ; 

call pr intchar ( cr ) ; 
call pr in tchar ( 1 f ) ; 
end cr 1 f ; 



printdec: proc( value) ; 



del 


value addr, 


i byte, count 


byte ; 


del 


dec i 


(4) addr 


initiaK 1000, 


, 100, 10, 1) 


dc 1 


f lag 


byte; 






flag 


= false 


5 






do i 


= 0 to 


3; 






count 


= 30h; 








do 


whl le 


value > = 


dec i ( i ) ? 






va lue 


= value 


- dec i ( i ) ; 






f lag= 


true ; 








count 


= co un t 


+ 1; 





end ; 

if flag or ( i>= 3) then 
call pr in tchar ( count ) ; 
e lse 
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call printchar( ’ ’); 

end ; 
re tur n ; 
end printdec; 



pr intOprod .'proc; 

call print(.’ prod = O’); 
call pr in tOdec( produc t ion) ; 
call cr 1 f ; 
end pr intOprod; 



printOto ken: proc; 

call print(.* token = O’); 
call pr intOdec ( token) ; 
call cr 1 f ; 
end printOtoken; 



clearOli neObuff: proc ; 

call f i 1 1 (. 1 inebuf f , ’ * , conbuf f s ize ) ; 

end c learSl ineObuf f ; 



listline: proc( length) ; 

del ( length, i) byte; 

call pr intSdec ( 1 ineno ) ; 
call printCchar(’ ’); 
do i 5 0 to length; 

call pr in tchar ( 1 inebuf f ( i )) ; 
end ; 

call cr 1 f ; 
end listline; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 

/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/ 

/XXX parser variables XXX/ 

/ V> »2n» vi» vV vV *J> \±* *J> v2/ vV vi» \L* %V *> s> ^ ^ ^ vl/ v> \Lr \> sj> *1* O# \> ^ ^ ^ ^ \V / 

/ <r» <|S «T* *T* «T* «r* m s # r # r* ^ *t* v *7* *4* *T* *?» ^r> **> *p* <p *'*> ^ *T> ^r» n' ^ ^ if* ^#f* #r* 4* if* #f* 4* if*<f* <f* 4* if* / 

/ 'IfSt' '£»*>«> *> *> V> sj> *>*>*J> *1/ *> *> *> **> *>*>*> *1/ *> 0 *J> vJ> V> V> vJ> vl* \1+ *J> *> *J> *J> v]l vV O# *!**> *ll *i» vil *ll Vi* Oi sJ* ^ *1|*>*> / 

/ <r* <r* «r* ^f* •r v «r* *r> *T* / i' <r» *♦> *r* 'f* *r* n* <r* »T* ^p <p <p <r* ^p #f* ^p <r* /p 4* ^p /p **v ^p ^p *!** /p if* «f* 4* ip ip 4* ip 4* 4 * *r> 4 ^ 4* if* ip 4 * ^p ip 4* ip / 



1 is tprod 


byte 


ini t ia 1 ( f a lse > 


lower to upper 


byte 


ini t la 1 ( true ) , 


1 is tsource 


byte 


ini t ia 1 ( false) 


debugln 


byte 


ini t ia 1 ( fa lse ) 


1 i s 1 1 0 ke n 


byte 


ini t ia 1 ( fa lse) 


c 0 mp i 1 1 ng 


byte ; 





/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 
/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 
/XXX scanner procedures ***/ 

/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 

/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/ 

ge tchar: proc byte; 

del addeof data ( ’eof * , eolchar* If) ; /X add to end if left off X/ 



nextOsourceOchar : proc byte; 

return sourcebuf f ( sourcep tr ) ; 
end ne x t Os o ur c e Sc ha r ; 



checkfile: proc byte; 

do forever; 

if ( sourcep tr : =sourceptr+ 1 ) > =cursourcerecs ize then 
do ; 
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sourcep tr = 0 ; 

if readGsourceGf ile=flleeof then 
return true; 

end ; 

if ( nestchar : =nestGsourceOchar) < > 1 f then 
return false; 

e nd ; 

end checkf i le ; 

if checkf ile or (nestchar = eoffiller) then 

eof reached #/ 

cal 1 raove( .addeof,sbloc,5) ; 
sourceptr = 0; 
aestchar=nezt6sourceGchar ; 
end ; 

linebuffC 1 inep tr : = 1 ineptr + l)=nestchar; /^output line*/ 

if nestchar = eolchar then 
do ; 

line no = line no + 1; 
if listsource then 

call listline(lineptr-l); 
lineptr = 0; 
call c lear 1 inebuf f ; 
end ; 

if nestchar = tab then 
nestchar = * * ; 

return nestchar; 
end ge tchar ; 



ge tnoblank: proc ; 

do whi le (( ^e tchar = ' ’) or (nestchar = eoffiller)); 

end ; 

end ge tnoblank; 



titleJproc; /* compiler version */ 

call crlf; 

call print( * * toggles set3*); 
ca 1 1 cr 1 f ; 

call print( ♦ ’pascal-m vers 1.03’); 
call crlf; 
call crlf; 
end title; 



pr IntGerror '• proc ; 

call pr intdec ( errorcount ) ; 
call pr intchar( ’ ’); 

call pr int (.’ error ( s ) detectedS’); 
call crlf; 
end printSerror; 



error • proc ( e rrcode ) ; 
del erreode addr, 
i byte ; 

errorcount =error count + 1 ; 
call pr int( . ’ ’ ) ; 

call pr intSdec ( 1 ineno ) ; 
call print(.’ error 3*); 
call printchar(’ ’); 
call pr intcharC highC erreode )) ; 
call pr intcharC low( erreode )) ; 
call printC.* near 3’); 
call printcharC’ *); 
do i = 1 to accum; 

call pr intcharC accumC i )) ; 
end ; 

call crlf; 
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call pr int( . 'at error $*); 
call pr intchar( ’ ’); 

call printOtoken; 
call pr int( . ’at error S’); 
call pr intchar( ’ *); 

call printGprod; 
if token=eofc then 
do ; 

call pr intOerror; 
call mo n3 ; 
end ; 

end error; 



ini t ia 1 izeCscanner : proc; 
dc 1 count byte ; 
call ope nOsource f i le ; 

1 ineno , 1 inep tr = 0; 
call c learO 1 ineObuf f ; 
sourceptr = 123; 

call getnoblank; 
do while nextchar = ’S’; 

call ge tOnoOb lank; 

if (count := (nextchar and 5fh) ~ ’a’) <= 4 then 
do case count ; 

listsource s true; 
listprod = true; 
nointfile = true; 
listtoken = true; 
debugln = true ; 

end; of case %/ 

call getnoblank; 
end ; 

end initializeSscanner; 



JfC Jf» 5fC *£ 5f» *f» 5f» JfwfC JfCIjC 5f» JfC JfC JfCJf? »j* 

J v> vV sV sV viz si/ vV vb v!> ^ vV V*/ v*> s’/ vV vp ^ «sL» si> ^ *1/ vj> vL# 0> ^ vV vi/ «!/ *to vto vi» sU Uo <io \f/ U/ vLo <•# 1*0 «!• *J> «!/ \L/ vl* > 

/ ^ ^ ob ^ ^ d' ofv <b ofv ^ of* **> <b /(» <l> ^ #r» 

/sfcsfoK scanner %*%/ 

y O/ «io\p 4* ^ vS» O «1* *J> kV ^ Vk *>\t*^* 0» ^Lo <y >> 4» \!o ^ >2o \> «JL» v> vio vV / 

/ /f» ob 'b ^b *b *b *b ^b <b *b ^b *b <+ *b *b «b <b *b <b *r» 'b ^b v ^b 'b *b ^b ^b ^b ^b ^b^'b ^b *7' *b n» ^b 'b ^b # b *b ^b 'b ^b v ^b ^b ^b ^b »b *b <b *b *b 'b *b 'b ^b «b 4v *b *b ^b *b »b / 

scanner: proc; 

del f lag byte; 



putinaccum: proc; 

if not cont then 
do ; 

accum(accura := accum + 1) z nextchar; 
hashcode = ( hashcode+nextchar ) and hashmask; 
if accum = 31 then cont = true; 
end ; 

end putinaccum; 



putandget: proc; 

call putinaccum; 
call getnobl ank ; 
end putandget; 



putandchar : proc; 

call putinaccum; 
nextchar = getchar; 
end putandchar; 



numeric: proc byte; 

re turnC next char - *0*) <= 9; 
end numeric; 
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lowercase : proc byte; 

return (nestcbar >= 61h) and (nextchar <= 7ah) ; 
e nd lowerGcase; 



dec ima lp t ? proc byte; 

return nextchar = * . * ; 
end dec ima lpt ; 



convOt oOupper : proc ; 

if lowercase and lower to upper then 
nextchar =next char and 5fh; 
end convQ toGupper ; 



letter* proc byte; 

call convO t oGupper ; 

return ((nextchar - *a*) <= 25) or lowercase; 
end letter; 

alphanum: proc byte; 

return numeric or letter ; 
end alphanum; 

spoo lnumer ic ? proc; 

do while numeric; 

call putandchar; 
end ; 

end spoo lnumer ic ; 



se tupGnextGca 1 1 ? proc; 

if nextchar = ’ * then 

call getnoblank; 
cont = false; 
end se tupGnextGca 1 1 ; 



lookup? proc byte; 

del maxrwlng lit *9’; 



del vocab data(0, ’S’ V ’ 

, * : ’ , ’ = * , * . . • , ’ (*’ , ’*) # , ’ : = # , ’do’ , 1 if ’ , * in* , ’of ’ , ’or • , ’ to ’ , ’eof ’ 

, ’and’ , *div* , ’end’ , ’ for’ , ’mod’ , ’nil* , ’not ’ , ’set’ ♦ * var ’ , * case * 

, ’else’ , ’file’ , ’goto* , ’read’ , ’ then* , ’ type ’.’with’,’ array’ , ’begin’ 
, * cons t * , * la be 1 * , * unt i 1 ’ , * whi le* , ’write* , * down to * , * packed ’ 

, ’ read In* , ’ record ’ , ’repeat’ , ’(empty) * , * program’ , ’wrlteln’ 

, ’ f unc t ion* , ’ procedure ’ ) ; 

del vloc da ta( O , 1 , 15,35,65,97, 132, 162, 1S3, 191, 200) ; 
del vnuo da ta( 0 , 1 f 15 , 25 , 35 , 43 , 50, 55 , 60, 6 1 ) ; 
del count da ta( 0, 13, 9, 9, 7, 6 , 4, 2, 0, 0) ; 



del ptr addr , (field based ptr) (9) byte; 
del i byte; 

compare? proc byte; 
del i byte; 
i = 0; 

do while (field(i) = accum( i ?= i + 1)) and i <= accum; 

end ; 

return i > accum; 
end compare; 



if accum > maxrwlng then 
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return false; 
ptr= vloc(accum) +. vocab ; 

do i = vnum( accum) to ( vnura( accum) +count ( accura) ) ; 
if compare then 
do ; 

t o ke n= i ; 

if i = 53 then 

the following code sets up storage 8 */ 

/* pointers for record entries in the */ 

/* symbol table. */ 

do ; 

recGns t = r ecGns t + 1 ; 

aptraddr , recOparOadr( recCns t ) =sb tb 1 ; 

addrp tr =00©0h? 

aptraddr=aptraddr+2; 

addrp tr=prvOsbtb IGentry; 

prvCsb tb lOent ry=sb tb 1 ; 

aptraddr=aptraddr+2; 

by tep tr = 1 f h; 

sb tb l = sb tb 1+9 ; 

/* record in i t i aza t ions */ 

var iantGpar t ( recGns t ) , tagGf d< recSns t ) = f a lse ; 
f xdOo f s tObse ( recGns t ) =Q000h; 
varOo fs tGbse ( recGns t ) =0000h; 
curOofs t ( recGns t ) =©0©0h; 
varGcasOva 1( recCns t ) =0000h; 
recordOp tr = - 1 ; 
end ; 

return true; 
end ; 

p tr = p tr+accum; 
end ? 

return false; 
end lookup; 



J ^ ^ si* U* v</ ^ O# V*/ si* V*/ ^ ^ %> v*> ^ ^ v** v> »> \V ^ ^J> vV si* «,*/ vV O# %V si* vii» ^ ^ / 

/ *** ^ ^ ^ ^ o' *r» d' d' *v* ^ »p o' 'i' 4* *!> #T» d' 'b / b ^ ^ V *r* *b / 

/*** scanner - main code 



do forever; 

accum, hashcode , token = 0; 
do while next char = eo lchar ; 

call getnoblank; 
end ; 

if (nextchar = stringdellm) or cont then 

do; /# found string */ 

token = stringc; 
cont = fa lse ; 
do forever; 

do while getchar <> stringdellm; 
call putinaccum; 
if cont then return; 
end ; 

call getnoblank; 

if nextchar O stringdellm then 
re turn ; 

call putSinSaccum; 

end; /* of do forever */ 

end; /* of recognizing a string */ 



else if numeric then 
do ; 



/* have digit */ 
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token = number c ; 
typenuw = integers type ; 

do while nex tchar= * 0 ’ ; /*e 1 ira leading 
nestchar=ge tchar ; 
end ; 

call spool nume r i c ; 
if decimalpt then 
do ; 



call putandchar; 
typenum = rea 13 type ; 
call spoo lnumerlc ; 
end ; 

this takes care of expon. foi'm 
if nextchar = *e* then 

do ; 



zeros*/ 



typenum = uns ignSexpon; 
call putandchar; 

if nextchar = or nextchar = * + ’ then 

do ; 



call putandchar; 
typenum = s ignedOexpon; 
end ; 

call spoo 1 nume r ic ; 
end ; 

if accura = 0 then 

has he ode , accum( accumJ = 1 ) = ’0*; 

call set upOne x t Oc a 1 1 ; 
re turn; 

end; /* of recognizing numeric constant 



*/ 



else if letter then 

do; /* have a letter */ 

do while alphanum; 

call putandchar; 
end ; 

if not lookup then 
do ; 

token = identifier; 
call se tupSnext Oca 1 1 ; 
re lurn ; 
end ; 

else /* is a rw but if comment skip */ 

do ; 

call se tSupGnextSca 1 1 ; 
re turn; 
end ; 

end; /* of recognizing* rw or ident */ 



else /* special character */ 

do ; 

if nextchar - ands ign then 
do ; 

nextchar = getchar; 

do while nextchar <> ands ign; 

nextchar = getchar; 

end ; 

call ge tSnoSb lank; 
end ; 
c lse 
do ; 

if nextchar = * ♦ * then 

do ; 

call putandchar; 
if nextchar = ’ = ’ then 

call putandget; 

end ; 
e lse 

if nextchar = ’ . * then 

do ; 

call putandchar; 
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then 



1 f nextchar = * . * 
call putandge t ; 



check for exponent */ 
if nextchar = ’e* then 

do ; 



e lse 

if numeric then 
do ; 

token = numberc ; 

typenum = re a 1C type ; 
call spoo lnu*ner ic ; 



typenum=uns ignSexpon; 
call put and char; 

if nextchar = or nextchar = then 

do ; 



typenum=s ignedSexpon; 
call putandchar; 
end ; 

call spoo lnumer ic ; 
end ; 



call se t OupSnex t Sc a 1 1 ; 
re turn; 
end ; 

end ; 
else 

if nextchar = ’(’ then 

do ; 

call putandchar ; 
if nextchar = then 

call putandget; 

end ; 
else 

if nextchar = then 

do ; 

call putandchar ; 
if nextchar = ’)’ then 

call putandget ; 

end ; 
else 

call putandget; 



if not lookup then 
call error ( ’ ic ’ ) ; 
call se tupCnextCca 1 1 ; 
re turn; 
end ; 

end; of recognizing special char 

end ; of do forever 

end scanner; end of scanner 



/'XXXXXCXXXXXXXXXXXXXXXXXXXXXXXXXXXXyfCXXXXXXXXXX##***####**##**####*###**/ 

/ \> vV sp «J> V*/ \k» vL» sp vN sj* rnj* tp sj* vl> r# v£# vp vV tp U* vV si/ *J> vl/ O/ vl/ \!/ vt* \L» \V vU «i* O/ »!/ / 

/*** procedures for synthesizer ***/ 

/ U# %J+ %>«*# O/ %> s> O/ vb %>«*#«!# %•# vt# «1# %VvL» vl/ VA» sf/ s!/ ^ vj> vN <>> *•# \L* V*# \1» *I> vi< vj> i*/ »!/ mj* v*/ *]/ «V / 

^ 'f* »p d' n> »|> /pd> *t + ip d’ n' ^ d' M" n' ^ /p ^p <P #p *p ^p 'p <p *p *p ^ ^ <p ^p *p 'p *p <p *P <T* ^p ^ d’ »p *p »p /p ^p ^p d' / 

/ O/ vV \Lr \1* sl+%1* vl> O/ *1* v> *1» \> \l* vV O/ s»> Oy *u vN Oy « s l# V/ sly %** Oy «># %A» sA*«,>Oy ^iy s/y vjy %Iy *1# \*y O* «1# vi# vM %ly %ly Cy vly vL> ^y s*y \<y ■»> vL» Oy Oy iu % *# Py dy«> / 

/ *p -T* 'T* yp ^ yfk <» <p «T» /f* /f* *f» /]S ^ Jf% #,S #p *?> 'f* *T* -T* /p «T> /p^P'P # P /p'P'r 'p ^ /p ^ yp *r* 4' /p <p yJS^S <v yp /fv yf> / 

in i t ia 1 izeOsymt b 1 : proc ; 
del symbase addr; 

do ; 

call f i 1 1 ( . hash tab le , 0 , shl ( hashtb Is ize , 2) ) ; 
symbase= .ini tSsymbO tb 1 ; 
sb tb 1= . memory; 

ini tSsyrahGtb 1 ( 15 ) =high( symbase ) ; 
in 1 tGsymbS tb 1 ( 16 ) = lowC symbase ) ; 
ini tSsymbO tb 1 ( 25) =high( symbase+ 13) ; 
ini tSsymbG tb 1 ( 26) = low( symbase+ 13) ; 
ini tSsymbO tb 1 ( 35) = high( symbase +23) ; 
ini tSsymbG tb 1 ( 36) = lo>/( symbase +23) ; 
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ini i Os ytubS t b 1 ( 48) -highC symbase+33) ; 
ini tCsymbCtb 1 ( 49) = lowC symbase+33) ; 
ini 1 5 s ymb3 tblC59) = hi ghC s ymbase +46 ) ; 
ini tOsymbStb 1 ( 60) = low( symbase+46) ; 
ini tSsymbGtb 1 C 7 1) =highC symbase+57) ; 
ini tCsymbO tb 1C72) = 1 owC symbase+57) ; 
ini tCsyisbStb 1 ( 85) =highCsyrabase+69) ; 
i n i t OsymbO t b 1C86) = 1 owC symbase + 69 ) ; 
hashtableC 14) =symbase ; 
hashtableC36) = s ymbase + 13 ; 
hash tab le ( 30) = symbase +23 ; 
hasht ab le ( 0) = symbase+33 ; 
hash tab le ( 16 ) =symbase+46 ; 
hasht ab 1 e ( 1 13) =symbas e+57 ; 
hashtableC 64) = symbase +69 ; 
hashtableC 1C7) =symbase+83 ; 
prvOsb ib ICentry = symbase+83; 



end ; 

sb tb 1 top= max-2; 
vecptr=0: const0ptr=0; 
cons tS indx-0 ; 
cons tSpnOp tr = 0 ; 
subrOp t r = 0 ; 
aryOdmOadrOp tr = - 1 ; 
arryCp tr = - 1 ; 
var iantGpart = false; 
arr ySqty=Q ; 
a 1 1 o cGaddr = G ; 

end ini t ia 1 izeCsymtb 1 ; 



J vi> \l* V> slA a/ O \V U/ «s> V> Hi* Hi* vV H> \i* H** H> h1* V*> h}* vL* H-’^ O/ vV Hp \t+ Hi* H>«> Hi* H> vV vV Hi/ % f> "»•>* \V H> vJ> \V V> vj> h|»h!>\V\Vh>\VhJ#H> / 

/ #6 *7. »?h * 6 #fH *|s, *7> ^ ^ ^ *f* <r» *r» •r* <»> ^ *v* d> * 7 * *£• «r* ^ *v» X 

/*** parser ***/ 



do; /* block for parser */ 

del state statesize, 

var(pstacksize) byte, 
hashC ps tacks ize ) byte, 
varc(varcsize) byte, 
var index byte, 

s ta tes tackC ps tacks ize ) statesize, 

C sp , mp , mpp 1 , no look) byte; 

/% nmumonics for pascal-sm machine 



endp 


lit 


’ 1 ’ 


, lb 1 


lit 


’ 2 ’ 


, nop 


lit 


’ 0 ’ 


, Id ib 


lit 


’3’ 


ldi i 


1 i t 


’4’ 


, envb 


lit 


* 9 » 


, envi 


lit 


’ 10 ’ 


, a 1 1 


1 it 


’ll’ 


1 1 1 a 


1 it 


’ 12 ’ 


, addb 


lit 


’ 13’ 


, add i 


1 it 


’ 14’ 


, sub i 


lit 


’ 16’ 


rcul i 


lit 


’ 18’ 


, d i vi 


lit 


’ 20 ’ 


, lss i 


lit 


’ 22 ’ 


, leql 


1 i t 


’24’ 


e qlb 


1 i t 


’25’ 


, eql i 


lit 


’26’ 


, ne qb 


lit 


’28’ 


, neql 


1 it 


’29’ 


ge qb 


1 i t 


’31 ’ 


>geql 


lit 


’32’ 


,grrt 1 


lit 


’34’ 


, negb 


lit 


’35’ 


negi 


lit 


’36’ 


, c 0 mb 


lit 


’37’ 


, comi 


lit 


’38’ 


, no tx 


1 i t 


’39’ 


andx 


1 it 


’40’ 


, bor 


lit 


’41 ’ 


, s tob 


lit 


’ 42’ 


, s to 1 


lit 


’43’ 


s 1 0 


lit 


’44’ 


, s tdb 


lit 


’45’ 


, s td i 


lit 


’46’ 


, s td 


lit 


’47’ 


derb 


lit 


’48’ 


, dcr i 


1 i t 


’49’ 


, dcr 


lit 


’50’ 


, br 1 


1 i t 


’52’ 


blc 


lit 


’53’ 


, 1 0 d 


1 i t 


’55’ 


, lodb 


lit 


’56’ 


, lod i 


lit 


’57’ 


rdvb 


1 i t 


’58’ 


, rdvi 


1 it 


’59’ 


, rdvs 


lit 


’60’ 


, wr vb 


lit 


’61 ’ 


wrvi 


lit 


’62’ 


, wr vs 


1 i t 


’63’ 


, cna 1 


lit 


’51’ 


, cn 2 i 


1 it 


’54’ 


dump 


lit 


’64’ 


, gr tb 


lit 


’33’ 


, lssb 


1 i t 


’21 ’ 


, le qb 


lit 


’23’ 


mu lb 


1 1 t 


’ 17’ 


, d i vb 


1 i t 


’ 19’ 


? 













ini t ia 1 izeGsynthes ize • proc ; 
codes ize = 0 ; 

end ini t ia 1 izeOsynthes ize ; 
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/XXX code generating procedures ***/ 



synthesize: proc ; 



/X synthesize local declarations #/ 



setaddrptr: proc ( o f f se t ) ; 
del offset byte ; 
aptraddr = base + offset; 
end setaddrptr; 

calcOvarc: proc(a) addr ; 

del a byte ; 

return var(a) + . varc ; 

end calcQvarc; 

set lookup: proc (a); 

del a byte; 

printname = ca lcovarc ( a) ; 

symhash = hash(a); /X hashcode of pn */ 
end set lookup; 



/ **#* *** ** X XX ^^XXXXX sfc* ******************* XXX# XX/ 



/X enterGlinks - this procedure enters in the X/ 
/X nest four bytes of the symbol table the X/ 
/X collision field and the previous symbol X/ 
/X table entry address field for the next */ 



/X symbol table entry. ( both in address var ) */ 

enterS 1 inks • proc; 

base , aptraddr = sbtbl; 
addrptr = hashtab le ( symhash) ; 
call se taddrp tr ( 2) ; 
addrptr - prvSsb t b lSen try ; 
prvCsb tb lSentry = sbtbl; 
hashtab le ( symhash) = base; 
end enterSli nks ; 

checkSpr in tSname ! proc(a) byte; 

/# a is offset from base to printname X/ 
del n based printname byte; 
del ( len, a ) byte ; 
call se taddrp tr( a) ; 

if ( len *•= byteptr ) = n then 
do while ( bytep tr ( len) =n( len) ) ; 
if ( len := len- I ) = 0 then 
return true; 
end ; 

return false; 
end checkSpr IntSname ; 



/XXXX*XXX*XXXXXXX**X*X*XX****XX*X*X*XX*XX*XX*X*X*/ 

/X lookupSpr int nameS ident i ty - this procedure */ 
/X is passed the location of an identifier in 
/X the production rule, and its target entry 
/* type, if the identifier is found with the 
/X correct type the procedure return true, 

/X else false is returned 



*/ 

%/ 

X/ 

X/ 

X/ 



/X else false is returned. 

/^XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 



lo okupSpnS i d • proc ( a , idSentry) byte; 
del ( a , idSen t ry) byte; 
call setloo kup ( a ) ; 
base = hashtab le ( symhash) ; 



146 



idSentry ) 



then 



do while base <> 0; 
call se taddrp tr ( 4) ; 
if (( byteptr and formmask ) = 
do ; 

if checkSpr intOname ( 5) then 
lookupGaddr=base ; 
return true; 
end ; 

else do ; 

call se taddrp tr ( 0) ; 
base = addrptr; 
end ; 
end ; 

re turn false; 
end lookupGpnS id ; 






/* limits - this procedure ensures that the */ 
/* symbol table entry about to be entered */ 
/* will not exceed the upper limit of the */ 
/* available symbol table addresses. X/ 
/X the parameter is the bytecount of the X/ 
/X entry to be entered. */ 



limits: proc(count); 

del count byte; 

if sbtbltop <= (sbtbl + count ) then 
do ; ‘ 

call error ( * to * ) ; 
call mo n3 ; 
end ; 

end limits; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 



/X enterSpr int nameS ident i ty — this procedure X/ 
/X loads the symbol table with the following*: X/ 
/X 1. collision field X/ 
/X 2. previous symbol table entry address X/ 
/X 3. form of entry ( preset byte "form" ) X/ 
/X 4. the length of the prlntname in one byte*/ 
/* 5. the printname characters */ 
/* parameter: printname is set prior to call. */ 



enterSpnSid : proc ; 

del (i,n based printname) byte; 

call 1 imi ts ( i : =n+6) ; 

call enterSl inks; 

call se taddrp tr( 4) ; 

byteptr = form; 

call se taddrp tr( 5) ; 

bytep tr=n; 

call move ( pr in tname+ 1 , sb tb 1+6 , n) ; 
sb tb l s sb t b 1+ 1 ; 
end enterSpnSid; 






/* ent erSvar iab leSldent i ty - this procedure */ 
/X calls enterSpnSid to load the symbol table */ 
/* entry currently being scanned, it also X/ 
/X generates the entry’s "form" by performing */ 
/* a boolean ’or’ ’ operation on the idSentry */ 
/* and the parameter "a". X/ 



Z*****^*****************************************/ 

ent erSvarS id : proc(a,b, idSentry) ; 
del ( a , b , idOentry) byte; 
if lookupCpnO id ( b , idSentry) then 
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return; 

/* else enter var name */ 
form = a or idSentry; 
call enterOpnSid; 
end enterGvarGid; 



/* setOlabel - this procedure assigns a label */ 
/* to the current declared label and increment*/ 

/* the labelcount ( next to assign ). */ 

setSlabel: proc; 

addrptr = lablcount; 
lab lcount = lab lcount+1 ; 
end se tS labe 1 ; 



/* enterSlabel - this procedure loads a label */ 
/* entry into the symbol table, symhash and */ 

/* printnams must be set prior to calling */ 

/*###*#*#:£*#*******:***#******#******&*******:£***;#:/ 

enterSlabel: proc; 
ca 11 1 iml t s ( 2) ; 

aptraddr = sbtbl; 
call se tS labe 1 ; 
sbtbl = sbtb 1+2 ; 
end enterSlabel; 



/^c^5fc^^jfc^c^?fc^Jr:^^^^^^*5f:^c*^«*^*********************/ 

/* lookupSonly - this procedure is passed the */ 

/% position of a identifier Just scanned in */ 

/* the current production ( sp,mp,mppl ) and */ 

/X returns true if the identifier is found in */ 

/# the symbol table. */ 

/****************JPK******************************/ 

lookupSonly: proc(a) byte; 
dc 1 a byte ; 
call se t lookup(a) ; 
base=hashtab le ( symhash) ; 
do while base <> 0; 
if checkSpr in tOname ( 5) then 
do ; 

lookupSaddr = base ; 
return true; 
end ; 

e lse do ; 

call se taddrp tr ( 0) ; 
base=addrp tr ; 
end ; 
end ; 

return false; 
end lookupSonly; 

convr t bed : proc(a»b); /* a = sp/mp/mpp 1 * b-pos/neg */ 

/**XXXX**XXXXXXXXXXX*XXXXX***XXXXX****/ 

/* this procedure converts a real */ 

/* number in the program to a bed */ 

/* representation. 

/^JfC^^^C^^^^^^^*****************^'*^^/ 

del < l,j,df lag.ef lag.sf lag.a.b.n based printname) byte 
del ( exponloop. exps Ignloop) label; 

call se t lookupt a) ; 
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/* initialize variables 
s f lag= false; ef lag=true; dflag=true; i= 1 ; 
do J=0 to 7; bcdnurnC j ) =0 ; end; 
j=0; expon=64; /* e+00 */ 

/* remove leading’ zeros 
do while <(n(i) - ’0’) = 0); 

i = i+ 1 ; 

if i = (n+l) then goto expo n loop; 
end ; 

load bcdnum with significant digits 
do while ((n(i) - *0* ) <= 9 or nCi) - ’.*); 
if n(i) = ’ . * then 

do; eflag=false; 

if i=n then goto exponloop; 
i = i + 1; 

end ; 
e lse 
do; 

do while J = 0 and dflag and (n(i) - ’O’) = 0 
expon = expon-1; 
if i = n then goto exponloop; 
i = i + 1 ? 
end ; 

if j = ( bcdsize-1 ) then goto exponloop; 
if dflag then first bed pair */ 
do ; 

bcdnum( j)=rol((n( i ) - 1 0 ’ ) ,4) ; 
df lag= fa lse ; i= i+1; 
if eflag then cxpon=expon+ 1 ; 
end ; 
e lse 
do ; 

bcdnum( J ) 3 bcdnum( J ) + ( n( i)-’0’) ; 
j = j + l; i s i + 1 ; 

dflag=true; if eflag then expon=expon+ 1 ; 
end ; 

if i=(n+l) then goto exponloop; 
end ; 

end; 

expon loop : 

if i = (n+1) then goto expsignloop; 
if eflag then 
do ; 

do while n(i) <> *.*; 

expon = expon + 1; 
i = i + 1 ; 
end ; 

i = i + 1 ; 
end ; 

do while i < (n+1) and (n(i)“*0’) < = 9 ; 

i = i + 1; 
end ; 

if typenum = realtype then goto expsignloop; 
/* n( i) = e */ i = i+1 ; 
if typenum = s ignedOexpon then 
do ; 

if n( i) = mlnusx then sflag = true; 
i = i + 1 ; 
end ; 

if i = n+1 then 
do ; 

call error ( ’ ee * ) ; 
return; 
end ; 

dflag = 0; 
do J 5 i to n; 

dflag = (df lag*10)+(n< j)-’0’ ) ; 
end ; 

if sflag then exponent calculation 
expon - expon-dflag; 
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else expon = ezpon + dflag; 
exps i gnloop: 

bcdnum( beds ize- 1 ) =ro 1 ( b , 7) ; /* sign of number */ 
if expon > 127 then 

do ; 

call error ( ’ ee ’ ) ; 
re turn; 
end ; 

e lse bcdnumCbcds ize- 1) =bcdnura( beds ize- 1) +expon; 
end convrtbcd; 

y v£> vt> sV vl> vl> sJ> O/ U* kIa \L» U# vl> *1# *J/ %*/ O/ <L» 0> o> J 

/* convert! - this procedure is passed "a", the*/ 

/* location of a constant in the production */ 
/v and "b" the ’sign’ of the integer, the */ 

/* function generates a signed 16 bit repre- */ 

/* sentation of the number and returns it in */ 
/* an address variable. */ 

/************************************************/ 



convert!: proc(a,b) address; 

del ( i,a,b,n based prlntnarae) byte; 
del num addr; 



call setloo kup ( a ) ; num = 0 ; 
do i= 1 to n; 

if (maxint/10) > = nura then 
do ; 

if (maxint/10) = num and (n(i)-’O’) > 7 then 
do ; 

call error ( ’ ie ’ > ; 
return num; 
end ; 

num= ( num* 10) + ( n( i)- ’ 0’ ) ; 

end ; 

else do ; 

call error ( ’ ie ’ ) ; 
return num; 
end ; 
end ; 

if b = pos then return num; 
if num = maxint then 
do ; 

call error ( ’ ie ’ ) ; 
return num; 
end ; 

re turn ( - num) ; 
end conver t i ; 



/sfc**********************************^************/ 

/* conver tScons tant - this procedure is called */ 
/* with type num set by the caller, the number */ 
/* must be pointed to by "sp" in the produc- */ 
/* t ion. the procedure returns with "cons tS */ 

/* numS type " and "cons tSva lue " set with the */ 

/* number in its internal form. 

/ife#*;*::}:#*##**###******************^^*****^***** 1 ''**^ 



convr tScons t : proc(a) ; /* a=pos,neg */ 

del a byte , in tSaddr addr; 

if type num = integerStype then 
do ; 

intSaddr = conver t i ( sp , a) ; 

cons tSnuraS type (const Sptr) = integer© type ; 
cons tSptr=cons tSptr+1; , . 

call mo ve ( . intSaddr, .co ns t S va 1 ue ( c o ns t S i nd x ) , 
cons tS indx=cons tS indx+2; 
end ; 

e lse do ; 
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call convr tbcd( sp, a) ; 

cons tOnumStype ( cons tOptr ) = rea 1G type ; 
cons tGp t r=cons tOp tr+ 1 ; 

call move ( . bcdnum, . cons tova lue( cons tS indx) , beds ize) 
cons tS indx= cons tC indx+beds ize ; 
end ; 

end convr t Geo ns t ; 



/XXXXXXXXXXXXXXXXXXX * * j,-; * X ;jc * # % : 



%/ 



/* enterOcons tan tCuumber - after the next entry*/ 
/* has had its links entered into the symbol */ 
/* table, this procedure enters the constant */ 
/* value into the symbol table and set the */ 
/* entry’s "form" to the appropriate type. */ 



enterGconsGaumb : proc; 

cons tGp tr=cons tGp tr- 1 ; 

if cons tSnumG type ( cons tGp tr ) = integertype then 
do ; 

call se taddrp tr ( 4) ; byteptr=S or consSentry; 
call limits(2); cons tG indx=cons t G indx-2 ; 
call mo ve ( . cons tGva lue(constGindx) , sb tb 1 , 2) ; 
sb tb l = sb tb 1+2 ; 
end ; 

else do ; 

call se taddrp tr( 4) ; byteptr= 10h or consCentry; 
call 1 imi ts( beds ize ) ; cons tG indx=cons tG indx-beds ize ; 
call move( , cons tSva lue( cons tO indx) , sb tb 1 , beds ize ) ; 
sbtbl=sbtb 1+bcds ize ; 
end ? 

end enterGconsGnumb ; 

/************************************************/ 

/* enterGstr ing - after the " links" and "form" */ 

/* are entered into the symbol table, this */ 

/* procedure loads any identifier along with */ 

/* its length, (used with constant strings */ 

/* and constant identifiers ) */ 

/****************»******************************/ 



enterGstr ingi proc(a); 

del (a,n based printname) byte; 
call setlookup(a) ; 
call 1 imi ts ( n+ 1 ) ; 

call move ( pr in t name , sb tb 1 , ( n+ 1) ) ; 
sb tb l=sb tb l+( n+ 1 ) ; 
end enterSstr ing; 

en t er Scons 0 i den t • proc( a , b) ; /* a=pos/neg , b = mp/rapp 1/sp */ 

del ( a , b , c ) byte; 
c = ro 1( a , 6) ; 

call se taddrp tr( 4) ; byteptr=c or consSentry; 

call enterGstring(sp) ; 

cons tCpnSp tr = cons tGpnSp t r— 1 ; 

cons tOindx=cons tSindx-cons tGpnGs ize ( cons tGpnSptr) ; 
end enterGconsG ident ; 

en terOcons tGentry ' proc; 
del ixindex byte; 
veep tr = veep tr- 1 ; 
do case cons tOvcc ( veep tr) ; 

/* case constant number */ 
call enterGconsGnumb; 

/% case identifier constant */ 
call enterGconsG ident ( pos , sp) ; 

/* case signed identifier constant */ 
call en terGconsG iden t ( neg , sp) ; 

/* case constant string */ 
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do; 

call se iaddrp tr ( 4) ; b7tepfr= ISh or consSentry; 

call enterGs tr ing(sp) ; 

cons tGpnCp tr= cons tSpnSp tr- 1 ; 

cons I0indx=cou3 tOindx-coas tOpnCs ize( cons tCpnOptr ) 
end ; 

end; /* of case cons tGtype */ 
end enterGcons tGentry; 

/ * * >ia * * * 5-< ^ Jfc JfC JjC jfc Jfc Jf? jfc JfC ig 5fC JfC ?£ Jfc jfc % J*C ^ J!{ $ JjC ^ ^ ^ / 



/* enter Oc o nip 1 e xO t ype - this procedure is */ 

/* called to enter the " 1 inks " and "form" for */ 
the ’complex type’ symbol table entries. */ 
noteS that this entry never has a print"* %/ 
/* # name assigned. 






enterOcomp lexG t ype * proc(a); 
del a byte; 

call 1 imi ts ( 5) ; 
base, apt raddr=sbtbl; 
addrp tr = CGGOh; 
call se taddrp tr ( 2) ; 
addrp tr=prvGsbtb ICentry; 
pr vGsb tb 1 Gen try= base ; 
call se taddrp tr( 4) ; 
bytep tr= a ; 
sb tb l = sb tb 1 + 5 ; 
end enterOcomp lexOtype ; 






/* enterGs true tG type - this procedure is */ 
/* called by the ’type’ productions: */ 
/* 1. set type %/ 
/* 2. file type */ 
/* 3. pointer type */ 
/* it calls enterOcomp lexOtype to set up its */ 
/* 11 li nhs" and "form", then it sets a pointer */ 
/* to the associated complex type. */ 






enterGs true tG type : proc(a); 
dc 1 a byte ; 

call enterScomplexGtype(a) ; 
call 1 imi ts ( 2) ; 
call se taddrp tr( 5) ; 
addrp tr = typeG loc t ; 
sb tb 1 = sb tb 1+2 ; 
typeOloc t=base ; 
end enterGs true tO type ; 

/* lookupG ident i f ier — this procedure is called*/ 
/% with ’symhash’ and printname set. it will */ 

/* return true if the identifier can be found */ 



lookupO ident : proc byte; 

base = hashtab le(symhash) ; 
do while base <> 0; 

if checkCpr in tCname ( 5) then 
do ; 

lookupGaddr= base ; 
re turn true ; 
end ; 

e lse do ; 

call se taddrp tr( 0) ; 
base=addrp tr ; 
end ; 
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end ; 

re turn f a lse ; 
end lookups ident ; 

/XXXXXXXXXXX**********************#**##**###**###/ 

/* lookupOpr intnameSonly - this procedure sets */ 



/* the "symhash" and calls lookups ident to */ 

/•' determine if the entry is in the symbol %/ 

/# table. the address of the printname is 
/* passed as a parameter, if the entry is %/ 

/* found, true is returned. %/ 






lookupSpnSonly • proc(a) byte; 

del a addr; /% addr of print-name %/ 
del (b,n based a) byte; 
hashcode=0 ; 
do b= 1 to n; 

hashcode= ( hashcode + n( b) ) and hashmask; 
end ; 

symhash 3 hashcode ; 
pr in tname = a ; 
if lookups ident then 
return true; 
else return false; 
end lookupSpnSonly; 

^fwfC /*C % JyC ^ ?fC 5|C 5fC 2fC 5fC 2fC / 

/# s toreScons t ant identifier - this routine is */ 
/% called with printname set to load an %/ 

/X identifier in the ’constant value* variable.*/ 

/ **> si* si* ^ ^ -nU si* si* si* si* O si* si* <1^ Sl* si* si* si* si* si* ^ si* si* si* ^ si* sX* si* s£* si* ^ si* sA* si* sl*sl*S^ %i* si * ^ si* S 
/ /b /b dS *11 + *fs *JS *7> <*T* *fs /JS <fs *js *fs*fs -T* Sfs^%*js *fs ifs / 



s toreScons tS ident J proc ; 

del n based printname byte; 
call setloo kup ( s p ) ; 

call mo ve ( pr in t name , . cons tSva lue( cons tS indx) , ( n+ 1 ) ) 
constSindx=const$indx+(n+l) ; 
cons tSpn$hash( cons tSpnSptr) =symhash; 
cons tSpnSs ize ( cons tSpnSptr) =n+ 1 ; 
cons tSpn$p tr-cons tSpnSptr* 1 ; 
end s toreScons tS ident ; 

subrSerror! proc; 
call error( * is ’ ) ; 

subrS type( subrSptr) = integer® type ; 
subrSva 1 ( subrSptr) =0000h; 
end subrSerror; 

ordShiS lowScheck: proc; 

if s ubrSp tr = 0 then return; 
if s ubrS type = subrS type ( 1) then 
do ; 

if subrSval > subrSval(l) then return; 
end ; 

call error ( * is * ) ; 
end ordShiS lo wScheck; 

subrSintShiSlowScheck: proc; 
if s ubrSp tr = 0 then return; 
if subrStype O subrStype( 1) then 
do ; 

call subrSerror; 
re turn; 

if^ubrSval < 32768 and subrSval(l) >32767 then 
do ; 

integerSdiff = subrSva l+( — subrSvaM 1)) + 1; 

re turn; 
end ; 
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if subrSval > 32767 and subrSval(l) < 32768 then 
do ; 

call subrSerror; 
re turn ; 
end ; 

if subrSval <32768 then /* both positive 
do ; 

i f ( subrSva l-( subrSva 1 ( 1 ) + 1 ) ) < 32768 then 
do ; integerSd i f f = subrSva l-( subrSva 1( 1) ) + 1 • 
re turn ; 
end ; 

call subrSerror; 
re turn; 
end ; 

else both negative 

if ( - subrSva 1( l)-( - subrSval +1)) < 32768 then 
do ; 

in tegerSd i f f 2 ( - subrSva 1 ( 1 )) -( — subr$val)+l; 
re turn; 
end ; 

call subrSerror; 
end subrS in tShiS lowSclieck; 

o* ^ 4* ^ ^ ^ ^ ^ sir >> vU vU »U / 

/ 'v' 4* a* ^r* *T* ^ 'b *v» ^ *r* v / 

/# subranges ident i ferSprocedure - this routine */ 

/* is called to determine the offset ( number */ 

/* of entries in a subrange ) and the type of */ 

/% subrange, given that the subrange type is */ 

/* a named identifier. %/ 

/ JfC J^C 5^» 5f» 5^» 5(» 5^» 3f» 5^* 5f» 



subrS identSproc • proc; 

cons tSpnSp t r = cons t SpnSp 1 1 — 1 ; 

cons tSindx=cons tSindx-cons tSpnSs ize( cons tSpnSptr) ; 
pr in t name 2 .cons tSva lue ( cons tS indx) ; 
symhash 2 cons tSpnShash( cons tSpnSptr) ; 
if not lookupSident then call subrSerror; 
else /* found constant identifier */ 
do ; 

base= lookupSaddr ; 

call se taddrp tr ( 4) ; /* points to form( by tep t r ) */ 
subrS form 5 byteptr ; 

if subrSform <> 07h and (subrSform and formmask) <> 
then call subrSerror; 
e lse do ; 

if subrSform 2 07h then 
do ; 

subrS type ( subrSp tr ) =ordStype ; 
call se taddrp tr( 5) ; 

subr Sf orm 2 bytep tr j length of p.name 

call se taddrp tr ( 6+subrSf orm) ; 
subrSva 1 ( subrSp tr ) 2 doub le( byteptr) ; 
call se taddrp tr( 7+subrSform) ; 
subrS type Saddr ( subrSptr ) 2 addrptr; 
call ordShiS lowScheck; 
end ; 
else 
do ; 

do while (( shr( subrSform, 3) and 3h)=0); 
if shr ( subrSform, 5) = neg then 

if subrSpnSs ign 2 pos then subrSpnSs ign 2 neg; 
else subrSpnSs ign 2 pos ; 
call se taddrptr ( 5) ; 
subrSform 2 byteptr ; 
call se taddrp tr( 6+subrSform) ; 
if not lookupSonly( ap traddr ) then 
do ; 

call subrSerror; 
subrSp tr=subrSp tr+ 1 ; 
re turn; 
end ; 



consSentry 
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e lse do ; 

base = lookupSaddr ; 
call se t addrp tr ( 4) ; 
subrSf orm=byt eptr ; 
end ; 

end ; 

if ( shr ( subrSform, 3) and 3h) = 2 then 

do ; 

call subr$error; 
subrSp tr = subr$ptr+ 1 ; 
re turn ; 
end ; 

here we have either an integer or char */ 
if ( s hr ( subrSform, 3) and 3h) = 1 then 

do; /* integer */ 

call se taddrp tr ( 5) ; • 

subrSf orm=byt eptr ; 
call se taddrp tr( 6+subrSf orm) ; 
if subrSpnGsign = neg then 

subrSva 1< subrSptr ) = - addrptr; 

e lse subrSva 1( subrSptr) = addrptr ; 
subrS type ( subrSptr) = integer© type ; 
call subrSintShiS lowScheck; 
end ; 
else 
do ? 

call se taddrp tr( 5) ; 
subrSform= byteptr; 
call se taddrptr( 6+subrSf orm) ; 
if byteptr <> 1 then 

do ; 

call subrSerror; 
subrSp tr= subrSptr* 1 ; 
re turn; 
end ; 

call se taddrpt r( 7+subrSf orm) ; 
if byteptr <41h or byteptr > 5ah then 
call subrSerror; 
else do; 

subrSva 1 ( subrSp tr) s doub le ( bytep tr-4 lh) ; 
subrS type( subrSptr ) s charS type ; 
call ordShiS lowScheck; 
end ; 

end ; 
end ; 
end ; 
end ; 

subrSp tr=subrSptr+ 1 ; 
end subrSidentSproc ; 

y \I> +4* S* ^ ^ ^ ^ sL* ^ ^ \L* sis +Jj> Of *J+ vU y 

f "T* "r ■r* «T fc 'T* <r* ^ ^ ^ ^ #r* ^ ^ ^ / 

/* subrangeScase - this procedure is used to */ 

/# determine the number of entries in a subrange*/ 

/ ✓fC 2fC 5jC 5fC 2fC JfC 5fC ^fc / 



subrScase: proc; 

subrSpnSs ign=pos ; 

do case cons tSvec ( veep tr) ; 

/* case const number */ 
do; cons tSptr =cons tSptr- 1 ; 

if cons tSnumS type ( cons tSptr ) =rea IS type then 
do ; 

call subrSerror; 
cons tS indx=cons tSindx-bcds ize ; 
end ; 
e lse 

do; /* integer type */ 

cons t $ indx=cons tS indx-2; 

call move( . cons tSva lue( cons tS indx) , . subrSva 1 ( subrSp tr) ,2) ; 
subrS type (subrSptr) = integer© type ; 
call subrS intShiS lowScheck; 
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end ; 

subrSp tr=subrSptr+ 1 ; /% next to fill %/ 
end ; 

case ident constant */ 
call subrS identSproc ; 

case signed ident constant 

do ; 

subrSpnSs ign=neg; 
call subrS identSproc ; 
end ; 

/% case constant string */ 
do ; 

const SpnSp t r = cons tSpnSptr- 1 ; 
cons tSindx=cons tSindx-cons tSpnSs ize(cons tSpnSptr) ; 
pr in t name = . cons tSva lue ( cons tS indx) ; 
if cons tGpnSs ize( cons tSpnSptr) <> 2 then 
call subrSerror; 
e lse 
do ; 

base=pr intname ; 
call se taddrp tr ( 1 ) ; 

if byteptr < 41h or byteptr > 5ah then 
call subrSerror; 
e lse 
do ; 

subrSva 1 ( subrSp tr ) =doub le ( byt ep tr-4 lh) ; 
subrS type ( subrSp tr) = charS type ; 
call ordShiS lowScheck; 
end ; 

end ; 

subrSp tr = subrSp tr + 1 ; 
e nd ; 

end; /* of case cons tSvec ( veep tr) 
end subrScase; 



enterSsubrangeSen try - this procedure is */ 

used to enter a subrange type entry into %/ 

/% the symbol table, this symbol table entry */ 

has no pr intname associated with it. %/ 






enterSsubrSentry: proc ; 
t ypeS loc t = sb tb 1 ; 
call 1 imi t s ( 14) ; 
vecptr= veep tr- 1 ; 
call subrScase; 
ve c p t r- ve c p t r- 1 ; 
call subrScase; 

call enterScoraplexStype ( shl ( subrStype , 6) or 0fh) ; 
call se taddrp tr( 5) ; 
if subrS type = in tegerS type then 
addrptr-. ini tSsymbSt b 1 ; 

if subrS type= charS type then addrptr=( . ini tSsyrabStb 1+23) ; 

if subrS type=ordStype then addrp tr=subrStypeSaddr ; 

call se taddrp trC 7) ; 

addrp tr=subrSva 1 ( 1) ; 

call se taddrp tr ( 9 ) ; 

addrp tr=subrSva 1 ; 

call se taddrp tr( 1 1 ) ; 

if subrS type = in tegerS type then range 0 to 64k. 

addrp tr = in tegerSd i f f ; may be greater than 32767 

else 

addrptr=( (subrSva l-subr$va 1(1))+1); 
subrSp tr = 0 ; 
sb tb l = sb tb 1+8; 
end enterSsubrSentry; 

typeSerror: proc; 
al locate=false ; 
call error ( ’it’); 
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end typeSerror; 



/XXXXXXXX***##***##*#*****#**#*****###########:!!###/' 

/* allocate offset - this procedure is called to*/ 

/* determine the number of bytes required for */ 

/* storage of a variable of the type given in */ 

/* the parameter *a*. the variable’s allcSqty */ 

/* and allcGform are set upon return. */ 

allcSoffset: proc(a); /* typeGloct */ 
del a addr; 

del ( a 1 IcGf orm, b) byte; 
base=a ; 

call se taddrptr ( 4) ; /* points to form of type */ 
allcGform- byteptr and formmask; 

if allcGform <> typeGentry and allcGform <> typedcle then 
do ; 

call typeSerror; 
a 1 lcGqty= 1 ; 
a 1 IcObas icG type = 0 ; 
re turn ; 
end ; 

do whi le ( C shr( byteptr , 3) and f orimnask) = 7 and a 1 lcSf orm 2 typeSen try) 
call se taddrp tr( 5) ; 
call se taddrp tr( 6+byteptr) ; 
base=addrp tr ; call se taddrp tr( 4) ; 
a 1 1 cGf orm=bytep tr and forimnask; 

if allcGform <> typeGentry and allcGform <> typedcle then, 
do; call typeGerror; 
a 1 lcGqt y= l ; 

a 1 lcGbas icGtype = 0; return; 
end ; 
end ; 

/* here exists either a basic type or a type declaration */ 
if allcGform = typeGentry then 
do; /* basic type */ 
do case ( shr ( by tep tr , 3) and formmask) ; 

/* integer */ 
do ; 

a 1 lcSqty-2 ; 

a 1 lcGbas icGtype= integerGtype ; 
end ; 

/* bed real */ 
do ; 

a 1 lcSqty=8; 

a 1 lcGbas icG type = uns ignSexpon; 

end ; 

/* character */ 
do ; 

a 1 lcGqty= 1 ; 

a 1 lcGbas icG type 2 charS type ; 

end ; 

/* boo lean */ 
do ; 

a 1 lcSqty= 1 ; 

a 1 lcGbas icG type = boo leanS type ; 
end ; 

end; /* of case */ 
a 1 loca te= true ; 
re turn ; 
end ; 

/* here exists a type declaration */ 

a 1 lcSform 2 ( shr( byt ep tr , 3) and formmask) ; 
if a 1 lcS f o r m= 0 then 
do; /* scalar */ 
a 1 locate 2 true ; 

a 1 lcSqty=doub le( a 1 lcSform+ 1) ; 
a 1 lcGbas ic0type = ord0 type ; return; 
end ; 

if allcGform 2 ! then 
do; /* subrange %/ 
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allocate = tr ue ; 

a 1 lcCbas icO type = comp lexO type ; 
b=shr ( bytep tr , 6) ; 

if b = 1 then a 1 IcOqty 3 doub le ( a 1 lcGf ornr*-l ) ; 

else a 1 lcCqty=doub le ( a 1 lcCf orm) ; return; 
end ; 

if a 1 lc 0 f o rra= 2 then 
do ; array 

a 1 locate 3 true ; 

a 1 IcObas icO type = co rap lexOtype ; 
call se t addrp tr ( 8) ; 
a 1 IcOqt y=addrp tr ; return; 
end ; 
b = 2 ; 

all other cases allocate an address field 
allc3qty=double(b) ; 
a 1 IcObas icO type 3 comp lexOtype ; 
a 1 locate 3 true ; 
end allcOoffset; 

a 1 IcO indexSo f f se t - this procedure is called %/ 
/# to determine the number of bytes required 
/X by an array to store the array’s components 
typeOloct is set prior to calling; this 
routine, an address variable containing the 
byte count is returned. 



a 1 IcO indesOo f f se t : proc addr; 
del a addr,b byte; 
a , base 3 typeG loc t ; 
call se taddrp tr ( 4) ; 

do while ( shr ( bytep tr , 3) and formmask) = 7 and 
( byteptr and formmask ) = typeOentry; 

call se taddrp tr( 5) ; 
call se taddrp tr( 6+byteptr) ; 
base=addrp tr ; call se taddrptr( 4) ; 
end ; 

/# here we have either a sea lar , subrange , boo lean, or char type 
b= shr( bytep tr , 3) and formmask; 
if (byteptr and formmask) 3 typeOentry then 
do ; 

if b = 0 or b s 1 t he n 

do ; 

call error(’ia’); 
b = 2; 

return double(b); 
end ; 

if b=2 then /% character subrange %/ 
do ; 

b = 26; 

recOvarS typ( re c Ons t ) = char 3 type ; 
ret ur n do ub 1 e ( b ) ; 
end ; 

/% boo lean 

recOvarO typ( re c Ons t ) = boo lea nO type ; 
b = 2; return double(b); 
end ; 

complex type */ 

if (( byteptr and formmask) O typeSdc le or 
(( b <> 0 ) and ( b <> 1 ))) then 

do ; 

call error(’ia’); 
b=2; return double(b); 
end ; 

if b=0 then 

do; scalar type */ 

r e cOvar 3 t yp ( recOns t ) = co mp 1 exO type ; 
call se taddrp tr ( 5 ) ; 
call se taddrp tr( 6+byteptr) ; 
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return doub le ( by t ep tr + 1); 
end ; 

/% subrange type %/ 

recGvarO typ( re c 3ns t ) =ordOt ype ; 
call se taddrp tr( 1 1) ; 
return addrptr; 
end a 1 IcOindexCo f fse t ; 






l> #i> »*» ^ ».» «|' 









/ 



/% se tOvar iab le3 type - this procedure is called X/ 
/>;: to set the variable type, variable sign, and */ 

address of the basic type given, the address*/ 
/* variable * lookupGaddr * is set prior to the */ 
/# call. */ 



se t Ova r3 type : proc; 

varGp tr = varOpt r + 1 ; base - lookupGaddr ; 
call se taddrp tr ( 4) ; 

if (byteptr and formcask) = consCentry then 
do; /* constant variable */ 
subrGpnGs ign=pos ; 

do while ( slir ( byt ep tr , 3) and 03h) = 0; 
if ( shr< by tep tr , 5 ) and 01h) = 1 then 

do ; 

if subrGpnGs ign=pos then subrSpnGs lgn=neg; 
else subrGpnGs ign=pos ; 
end ; 

call se taddrp tr( 5) ; 

if not Iookup0pn3only( ap traddr) then 
do ; 

call error! ’ ic * ) ; 

/# put in default values to return with */ 
re turn; 
end ; 

call se taddrp tr ( 4) ; 

if (byteptr and formmash) <> consOentry then 
do ; 

ca 1 1 error! * ic ’ ) ; 

put in default values to return with 
re turn; 
end ; 
end ; 

/X< here we have a non- ident i f ier constant variable */ 
if ( shr( byteptr , 3) and 3h) =1 then 
do; /* integer or boolean constant */ 
if base < 1000h then 

do; /* boolean %/ 
call se taddrp tr( 5) ; 
call se taddrp tr( S+byteptr) ; 

varCbase ( varGp tr ) =ap traddr ; varSs ign! varGp tr) = pos 
varCtype ( varGp tr) = 4h; 
end ; 

else do; /* integer constant */ 
call se taddrp tr( 5) ; 
call se taddrp tr! 6+byteptr) ; 

varGbase! varGp tr)=ap traddr; varG type! varGp tr) =5h; 
varGs ign! varGp tr ) = subrGpnGs ign; 
end ; 
re turn; 
end ; 

if (shr(byteptr,3) and 3h) = 2 then 

do; /* real constant */ 
call se taddrp tr( 5) ; 
call se taddrp tr! 6+byteptr ) ; 

var Gbase ( varGp tr) = aptraddr; varG t ype ( varop tr ) - 6h, 
varGs i gn( varGp tr ) = s ubr SpnGs ign; 
re turn; 
end ; 

/% default constant of string */ 
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cal 1 setaddrptr(5) ; call se taddrptr( 6+byteptr) s 
varObase ( varOp tr ) =aptraddr; varCtype( varSptr) =7h; 
re turn,* 

end; of constant variables %/ 
if (byteptr and formmask) = varGentry then 
do; /5S declared variables 
ptrptr = s hr (byteptr, 3) and forinmask; /% type of var 
call se taddrptr ( 5) ; call se taddrptrl 6+byteptr) ; 
varObaset varOptr) =addrptr ; /» relative addr of var */ 
sign is always ignored 
do case ptrptr; 

case 0 ord variable %/ 

do ; 

var 3 type ( varOptr ) = lOh; 
aptraddr=aptraddr+2; 

varGbase 1( varOptr) =addrptr; addr of parent %/ 

end ; 

case 1 integer variable 
var G type ( varGptr) =Q9h; 

case 2 char variable 
var G type ( varGptr) =Obh; 

/# case 3 real variable 
var G type ( varGptr) = 0ah; 

/v case 4 complex variable 
do; /% not implimented 

insert complex variable routines here 

end ; 

case 5 boolean variable 
var G type ( var Gp t r ) =08h; 
end; of variable case 

re turn; 
end ; 

if byteptr = 7h then 
do; scalar constant 

call se taddrptr ( 5) ; call se taddrptr ( 6+byteptr ) ; 
var Cbas e ( varGptr ) =ap traddr ; ap traddr = apt r addr + 1 ; 
varObase 1( varGptr ) =addrptr ; parent type of scalar 

var G type ( varGptr) = 1 lh; 
return; 
end ; 

end se tGvarStype ; 

loadGvar iab le — this procedure generates the %/ 

/* Intermediate code to load the next variable */ 

/% on the execution stack of the object file */ 



loadGvar iab le *. proc ; 

if varOtype( varGptr ) < 08h then 
do; /* constant variable 
aptraddr= varObase ( varOp tr ) ; 
if var 0 type ( varOp tr ) = 04h then 
do; /% boolean constant 
call genera te ( Id i i ) ; call genera te ( byteptr ) ; 
call genera te ( nop) ; high byte zero 
expCtypeC expGptr ) = boo leanGtype ; 
end ; 

if varC type ( varGptr) =05h then 
do; integer constant %/ 

call genera te( Id i i) ; call genera te ( byteptr ) ; 
call genera te( high( addrptr) ) ; 
if varGs ign( varGptr ) =neg then 
call generate(negi); 
expG type ( expGptr) = integerGtype ; 
end ; 

if varG type ( varGptr ) = ©6h then 
do; /* bed constant */ 
call genera te ( Id ib) ; 
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do ptrptr=l to (bcdsize/2); 
call genera te( by teptr) ; call genera te ( high( addrp tr) ) • 
ap traddr=ap traddr+2 ; 1 

end ; 

if varCs ign( varGp tr) = neg then 
call genera te ( negb ) ; 
e xpO type ( expOptr) =uns ignOexpon; 
end; of load bed 
if varO type ( varOptr) = ©7h then 
do; /X string constant */ 
call genera te( nop) ; /* not implimented */ 
expO type ( expOptr) =s tr ingOtype ; 
end ; 

varOp tr= varOp tr- 1 ; 
re turn ; 

end; /X of constant variable load X/ * 
if varSt ype ( varOptr) < 1 lh then 

do; /X simple variables X/ 
call genera te( lita) ; load addr of variable X/ 

ca 1 1 genera te ( low( varObase ( varOp tr ) ) ) ; 
call genera te( high( varObase ( varOptr) ) ) ; 
if varO t ype ( varOptr ) = ©Sh then 
do ; boolean variable 

call generate( lod) ; 
expOt ype ( expOptr) =boo leanOtype ; 
end ; 

if varOtype( varOptr) = 09h then 
do; /X integer variable X/ 
call genera te ( lod i ) ; 
expO type ( expOp tr) = integerO type ; 
end ; 

if varO type ( varOp tr) = ©ah then 
do; /X real variable X/ 
call genera te ( lodb) ; 
expOtype( expOptr) r uns ignOexpon; 
end ; 

if varO t ype ( varOp tr ) = Obh then 
do; /X char variable X/ 
call genera t e ( lod) ; 
expO type ( expOp tr ) = charS type ; 
end ; 

if varO type ( varOp tr>= lOh then 
do; /X ord variable 
call genera te ( lod) ; 
expO type ( expOp tr ) =ordOtype ; 

expO typeOaddr ( expOptr) = varObase 1 ( varOptr) ; 
end ; 

varOp tr= varOp tr- 1 ; 
re turn; 
end ; 

if varO type ( varOptr ) = 1 lh then 

do; /X ord constant 
ap traddr= varObase ( varOp tr) ; 
call generate(ldii); 

call genera te< bytep tr) ; call genera te ( nop) ; 
expO type ( expOp tr ) = ordO type ; 

expO t ypeSaddr ( expOptr) = varObase 1 ( varOp tr) ; 
varOp tr = varOp tr- 1 ; 
end ; 

end loadOvar lab le ; 



/X this procedure checks the top two X/ 
variables on the execution stack X/ 
/X for proper type. X/ 

/* i */ 



checkOexprsOtype * proc byte; 

if ( expO type ( expOptr) = expO type ( expOp tr- 1) ) and expO type ( expOptr )<> ©h 
then return true; 
if expO type ( expOptr) = lh then 
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do ; 

if expOtype( expOptr- 1) =3h then 
do ; 

call geaerate(cnvi); /» convert int to bed 
expCtypel expOptr ) =3h; 
return true; 
end ; 

else return false; 
end ; 

if exp 3 1 ype ( expGptr) =3h then 

do ; 

if e::p3 type ( expOptr- 1 ) = lh then 

do ; 

call genera te ( cn2 i ) ; /* convert second int to bed 
expO type ( expGptr- 1 ) =3h; 
return true; 
end ; 

else return false; 
end ; 

if expO type ( expOp tr) =0h then 

do ; 

if expO type ( expOp tr- 1 )<> 0h then 
re turn false; 
else 
do ; 

i f e xpOt ype Oaddr( expOpt r ) = expO typeOaddr ( expOp tr- 1 ) then 
return true; 

end ; 
end ; 

return false; 
end checkOexprsOtype ; 



/***# # % **** * ***##**;#;*** ********* XXX/ 

/* witeCstring - this procedure writes */ 
/* a string to the intermed. code */ 

writeSstr ing*. proc ; 

del n based printname byte; 
call se t lookup ( sp) ; 
call genera te ( wrvs ) ; 
call generate(n); 
do ptrptr = 1 to n; 

call genera te ( n( ptrptr )) ; 
end ; 

end wr i t eOs tr ing; 



/ ** ##***:}£:?:** * #*}#:**&*#*# ****** ********/ 

/# wr i teOvar iab le - this procedure will */ 
/* write a variable to the console via 
/* the intermed. code. 

/*****************************************/ 

wri teOvar : proc; 

if expOp tr = 11 then 

do ; 

call error ( * es * ) ; 
call mo n3 ; 
end ; 

expOp tr= expOp tr+ 1 ? 
call loadOvar iab le ; 
do case expOtype( expGptr ) ; 
call genera te ( wrvi ) ; 
call genera te ( wrvi ) ; 
call genera te ( wrvi ) ; 
call genera te ( wrvb) ; 
call genera te( wrvi ) ; 
call genera te C wrvi ) ; 
end; of expOtype case */ 
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e xpGp t r = expOp tr- 1 ; 
end writeOvar; 



/♦Jc readOvar iab le - this procedure generates */ 
the intermediate code to read a variable#/ 
/* from the console. 



readOvar: proc ; 

if varO type ( varOp tr ) < OSh then 
call error ( ’ ir ’ ) ; 
e Ise do ; 

if varG t ype ( varOp ir ) < llh then 
do ; 

if varOtype ( varGptr) =08h then 
do; /* read boolean not implimented #/ 
e nd ; 

if varGtype( varGptr) =09k then 
do ; 

call genera te ( rdvi) ; 
call genera te ( s td i ) ; 

call genera te( low( varObase( varGptr) ) ) ; 
call genera te( high( varGbase ( varGptr) ) ) ; 
end; 

if varOtype ( varOp tr) =0ah then 
do ; /* rea 1 */ 
call genera te ( rdvb) ; 
call genera te ( s tdb) ; 

call genera te( low( varObase( varGptr) ) ) ; 
call genera te( high( varGbase( varGptr) ) ) ; 
end ; 

if varOtype( varGptr) =0bh then 
do; /«fs read char not implimented */ 
end ; 

if varOtype ( varGptr) = 10h then 
do; /3S read ord not implimented 3(5/ 
end ; 
end ; 

if varG type ( varOp tr) = 1 lh then 
call error ( ’ ir ’ ) ; 
va rOp t r = varOp tr- 1 ; 
end ; 

end readOvar; 



if 1 is tprod then 
call printOprod; 



do case production; 



/#** produc t ions ***/ 

/ vL» «!/ ^ vb si# \f/ vt# si# si# sJL# vt/ vf/ O/ v> vl/ vL* v> s£# «!/ si# si# si# si# si# sV si# si# si# si# si# si# si# si# si# si# si# si# si# s'# si# V> Si# si# si# s> si# si# si# sA# si# s'# si# si# Vl# si# si# si# si# s'# si# \> si# si# si# / 

/ «T* #fs #r* ^ #Js #fs *Ts #J% #7% -p #js #^s #]S /JS *T* #*» #fs ^ #Js #fs#fs #js V •!> #*> #iS #N / 

/#*# the following is the input grammar ***/ 

/ # * # * * 5fC * * * * * * * * # * 5fC # # * * * JfC * * * * * * * * * * 5fC * * ?fC * * * * JyC 5fC * * * JfC & * * # # >fC # JfC * * 5fC # * * Jfc Jfc & * # 5jC / 



/* case 0 not used */ ; 

/# 1 <program> ::= <program heading> <block> « —I— 

do ; 

call printOerror; 
call printchar(’ ’); 
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call cr If ; 

call prlut( . ’ compilation coraple te .C’ ) ; 
call cr 1 f ; 

if not (errorcount > 0) then 
do ; 

call senerate(all) ; 
call genera te ( low( a 1 locGaddr) ) ; 
call genera te ( high( a 1 locGaddr) ) ; 
call genera te ( endp) ; 



end 


5 








call 


■writeGintGfile; 








ca 1 1 


c loseG intGf i le ; 








call 


mon3 ; 








end ; 










/* 2 


< program heading> 


program <prog 


ident> ( 


*/ 


/* 2 




<file ident> ) 


* 


%/ 


3 


♦ 


1 program <prog 


ident> ( 


*/ 


/* 3 


? 


< f i le ident> , 


< f i le iden t > ) ; 


*/ 


4 


< prog ident> *• • - < 


ident if ier> 




*/ 


5 


<file ident> : '• = < 


ide nt if ier> 




*/ 


if first 


Gtime then 








do ; 










firstGtime = false; 








call 


en t erSvarG id( 0 , sp , 


f i leGentry) ; 






end ; 










e lse 










call 


ent erGvarG id( 16,sp, 


f i leGentry) ; 






/* 6 


< b lock> • : = < ldp> 


<cdp> < tdp> <vdp> 


<p3fdp> <stmtp> 


*/ 


/* 7 


< ldp> ::= 






*/ 


/* 8 


1 labe 1 < 1 


abe 1 string) ; 




%/ 



/% 9 < label string • : = < labe 1> 

if typenum = integerG type then 
do ; 

call enterSvarO id( 0 , sp , lablGentry) ? 

call enterSlabel; 

end ; 

/% io 1 < label string 

if t ypenum - integerGtype then, 
do ; 

call enterSvarS id( 0 , sp , lablGentry) ; 

call enterOlabel; 
end ; 

11 < labe 1> ::= <number> 

if typenum O integerGtype then 
call error ( ’ Is ’ ) ; 



< labe 1> 



*/ 



%/ 



*/ 



/* 


12 


<cdp> 3 


: : = 








5 

/* 


13 




1 const < const 


de f > ; 






/* 


14 


< c o ns t 


def > : : = < ident 


cons t 


de f > 




/% 


15 




1 < const 


de f > : 


; < ident 


const def> 


i 

/% 


16 


< ident 


cons t de f > : • = i 


C ident 


c o ns t > 


= <constant> 



call enterGconstCentry; 
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17 < ident const> < identifier^ 

do ; 

if looknpGonly( sp) then 
call error(’dc’); 

call enterCvarO id( 0 , sp , consOentry) ; 
end ; 



/v 18 < cons tan t > * *• - <nuinber> 

do ; 

call convr tOcons t ( pos) ; 
cons t£vec( vecptr) =consCnumGtype ; 
vecptr = vecptr+l; 
end ; 

19 I <sign> <number> 

do ; 

if signtype-neg then 

call convrtCconst(neg) ; 
else call convi'tGcongt(pos) ; 
cons tSvec (vecptr) =consOnumO type ; 
vecptr=vecptr+ 1 ; 
end ; 

/* 20 I (constant ident> 

do ; 

cons tCvec (vecptr) =consS identSt ype ; 
veep tr = veep tr+ 1 ? 
call s toreCcons tG ident ; 
end ; 

/% 21 I <s ign> (constant ident> 

do ; 

if signtype r neg then 
cons tSvec (vecptr)=consGs ident S type ; 
e Isc cons tCvec (vecptr) =consG i dentS type ; 
vecptr=vecptr+l; 
call s toreGc ons tG ident ; 
end ; 

/% 22 I (string) 

do ; 

cons tSvec ( veep tr ) = consGs trS type ; 
vecptr=vecptr+l; 
call s toreGcons tG ident ; 
end ; 



/* 


23 (constant ident> • • 2 

? 


< ident if ie r> 


/* 


24 < s i gn> : * s + 

s ign type = pos ; 




/* 


25 1 - 

s ign t ype = neg; 




/* 


26 <tdp> 

c aseSs trat s fa lse ; 




/* 


27 1 type < type 

caseSstrnt=false; 


def string> ; 


/% 


28 < type def string) '• ** 


= < type id> 


/% 


29 


1 < type def string> 


/% 


30 < type id> : : = < type 


ids> = < type> 



do ; 

aptraddr = t ypeSaddr ; 
addrptr* typeGloc t ; 
end ; 

31 < type ids> ::= < identified 

do ; 

if lookupGonly( sp) then 
call error ( * d t ’ ) ; 
parents type = sb tb 1 ; 

call ent erSvarO id( 78h, sp , typeSentry) ; 



< type id> 



*/ 



*/ 



*/ 



*/ 



%/ 



*/ 



*/ 

*/ 

*/ 

*/ 



*/ 

*/ 

*/ 



*/ 



165 



call 1 imi ts ( 2) ; 
typeCaddr = sb tb 1 ; 
sb t b l = sb tb 1+2; 
end ; 



/% 


32 


< type > : : = <s impl 


e type> 


X/ 


/X 


33 


1 < structured type> 


X/ 


/X 


34 

? 


1 < po inter type> 


X/ 


/X 


35 


< s imp le type> : : = 


<scalar type> 


X/ 


/X 


36 


1 


<subrange type> 


X/ 


/X 


37 

? 


l 


< type ident> 


X/ 


/* 33 < type ident> <identlfier> 

if lookupSpnO id( sp , typeOen try) then 
typeG 1 oc t = lookupGaddr ; 
e lse 
do ; 

call error ( * t i ’ ) ; 

typeG loc t= . ini tOsymbStb 1 ; /X integer default X/ 
end ; 


X/ 


/X 


39 

? 


<scalar type> ::= 


C <tident string) ) 


X/ 


/X 


4© 


<tident str ing> : 


• ~ < ident i f ier> 


X/ 



do ; 

t ype So r dSnum= 0 ; 
typeG loc t = sb tb 1 ; 
if lookupOonly( sp) then 
call error ( * d t * ) ; 

call enterGvarO id( 0 , sp , typeSdc le ) ; 
ca 11 1 imi ts( 3) ; 

aptraddr=sbtbl; 
byt ep tr = 0 ; 

aptraddr=aptraddr+l; 
addrp tr=parentStype ; 
sb tb l = sb tb 1+3 ; 
end ; 

/X 41 f <tident string> , <identlfier> 

do ; 

type Cord Onum= type0ord3num+ 1 ; 
type G loc t = sb tb 1 ; 
if lookupGonly( sp) then 
call error ( ’ d t ’ ) ; 

call e nt erSvarO i d( 0*sp, typeSdc le) ; 
call 1 imi ts( 3) ; 
aptraddr=sbtbl; 
byte p tr = type GordGnum; 
aptraddr=aptraddr+l; 
addrp tr = pare ntS type ; 
sb tb l = sb tb 1+3 ; 
end ; 



/X 


42 < subrange type> (constant) •• (constant) 

call en terGsubrGen try; 


X/ 


/X 


43 


< structured type> : : = < unpacked structured type> 


X/ 


/X 


44 


1 packed 


X/ 


/X 


44 


< unpacked structured type> 


X/ 


/X 


45 


<unpacked structured type> • <array type> 


X/ 


/X 


46 


1 (record type> 


X/ 
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47 




/X 


48 






49 


< array type> 


/* 


49 



I < se t type > 

I < f i le type> 



of < component type> 

do ; 

if arrySptr = -1 then arrySptr=0; 
call enterCcomplexOtype ( 17h) ; 

arySdra»_>adrop t r - arySantSadrSp tr— numSarrySd imen( arry$ptr) ; 

arrySbase = base ; 

call 1 imi ts( ( nuinOarrySd imen( arrySptr) *2) +3) ; 

call se taddrp tr ( 5) ; 

by tep tr = nuinOarrySd imen( arrySptr) ; 

call se taddrp tr( 6) ; 

addrSp t r= typeS loc t ; 

call a 1 lcSo f f se t ( typeS loc t ) ; 
base s arrySbase ; 
call se taddrp tr( 8) ; 



addr p t r = arry3qty( arrySptr) *a 1 lcSqty; 
call se taddrp tr( 10) ; 
byteptr=allcSbas icS type ; 

do subrSf orm s O to ( numSarrySd imen( arrySp tr) - 1 ) ; 
call setaddrptrC 1 l+( 2 J fcsubr8f orm) ) ; 
addrptr= arrySd imen( arySdmSadrSp t r+subr f orra+ 1 ) ; 
end ; 

typeS loc t = base; 

sbtbl=sbtbl+(( numGarrySd imen( arrySptr) *2) +6) ; 
arrySp tr= arrySp tr— 1 ; 
end ; 



< rp> 



*/ 

*/ 

*/ 

*/ 



/* 

1 


50 

i 


<lp> :: 


= (* 


*/ 


/X 

\ 


51 

! 


< rp> : i 


= *) 


X/ 


/X 


52 


< index 


type string) ' ' = < index type> 


*/ 



do ; 

If arrySp tr=arrySnes t-1 then 



do ; 

call error ( * an * ) ; 

arySdmSadrOp tr = arySdmSadrSp t r-numSarrySd imen( arrySp tr ) ; 
end ; 

else arrySp tr = arrySptr+1; 
arryCd imSp t r = 0 ; 

arySdmSadrSp tr= arySdmSadrSp tr+ 1 ? 
arrySd imen( arySdmSadrSp tr) = typeS loc t ; 
arr ySqty( arrySptr) =a 1 IcS indexSo f f se t ; 
numGarrySd i me n( arrySptr) - 1 ; 

e nd ; 

/* 53 I < index type string> , X/ 

/X 53 < index type> */ 

do ; 

if arrySd imSp tr=maxSnumSarrySd 1 men- 1 then 
call error(’ad’); 

else arrySd imSp tr=arrySd imSptr+ 1 ; 

arySdmSadrSp tr =arySdm$adrSp tr+ 1 ; 
arrySd iraen( arySdmSadrSp tr ) = typeS loc t ; 

arrySqty( arrySptr) -arrySqty( arrySp t r ) *a 1 IcS indexSo f f se t ; 
numSarrySd imen( arrySptr) = numSarrySd imen( arrySptr ) + 1 ; 

end ; 



/X 

1 


54 

i 


< index type> 2 2 s 


< simple type> 


/X 


55 


< component type> 


: : = < type> 



/X 56 < record type> 2 2 = record < f le Id llsO end 



*/ 
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do ,* 

var iantOpar t ( recSns t ) = fa lse ; 
base , t ypeS 1 oc t = re c Spar Sadr ( recSns t ) ; 
if varGcasSva 1 ( recSns t ) <> 0 then 
call error( * iv’ ) ; 
call se taddrp tr( 5) ; 
addrp tr= f xdSo f s tSbse ( recSns t ) - 1 ; 
call se taddrp tr( 7) ; 
addrp tr= prvSsb tb lSen try ; 
recSns t = recSns t — 1 ; 
end ; 





? 


57 


< field 


1 i s t > = 


< f ixed par t > 


*/ 






58 




1 


< f ixed par t > ; < variant part> 


*/ 




? 


59 




1 


<variant part> 


*/ 






60 


< f ixed 


par t> : : = 


<record section> 


*/ 


/* 


f 

f 


61 




1 


< f ixed part> ; <record section> 




/* 




62 


< record 


sec t ion> 


• < f ie Id ident str ing> : < type> 





do ; 

call a 1 lcSo f f se t ( typeS loc t ) ; 

al lcSbas icStype and allcSqty are set */ 



do ptrptr = 0 to recordSptr; 
base - recSaddr( ptrptr ) ; 
call se taddrp tr( 5) ; 
call se taddrp tr( 8+bytep tr) ; 
addrp tr=allcSqty; 
ap traddr = ap traddr+2; 
addrp tr = typeS loc t ; 
ap traddr = ap traddr+2; 
addrp tr=curSofs t( recSns t) ; 
curCofst ( recSns t ) =c urSo f s t ( recSns t ) 

+ allcSqty; 

end ; 

recordSp tr =0 ; 

if f xdSo f s tSbse ( rec Sns t ) < curSo fs t( recSns t) 

then f xdSo fs tSbse( recSns t) =curSo fs t ( recSns t ) ; 
end ; 



/* 

5 


63 






1 




*/ 


/* 


64 


< field 


ident 


s tr ing> : : = < f ie Id 


iden t> 


*/ 


» 

/* 


65 






1 < f ie Id 


ident string^ , 


*/ 


/* 


65 






<f ield 


iden t> 


*/ 




66 


< field 


ident> 


: : = < ident i f ier> 




*/ 



do ; 

if recordSptr <> 5 then recordSp tr=recordSp tr+ 1 ; 

else call error(’rn , >; 

recSaddr(recordSptr)=sbtbl; 

call en terSvarS idC 58h, sp , typeSdcle) ; 

call 1 imi ts ( 8) ; 

ap traddr = sb tb 1 ; 

addrp tr=recSparSadr ( recSns t ) ; 

sb tb l = sb tb 1+8; 

if var iantSpar t ( recSns t ) then 
do ; 

base 2 recSaddr( recordSp tr) ; 
call 1 imi ts ( 2) ; 
call se taddrp tr( 4) ; 
bytep tr = 0df h; 
end ; 

e nd ; 
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/m 

/<> 




67 

67 


< var lant part> ::= case < tag f ie ld> < type ldent> of 


*/ 






< variant string-> 


*/ 


/% 

/* 




68 

68 


1 case < type ldent> of 


*/ 


» 


< var lant string 


%/ 


/* 




69 


< var lant string^ r:= < variant) 


*/ 


/* 


» 


70 


1 < var ian t string) ; <varlant> 


*/ 




71 < tag f ie ld> <field ldent> r 

tagSf d< recSns t ) = true ; 


%/ 


/* 


♦ 


72 


< var lan t > <case label list> : ( <fleld llst> ) 


*/ 


/* 


9 

9 


73 


1 


*/ 


/* 




74 


< case label list> ::= <case label> 


*/ 


/* 


9 


75 


1 <case label 1 is t> , <case label> 


*/ 


/$ 




76 


<case labe 1> <constant> 


%/ 



if caseOstmt then 



do ; 

insert case stmt routines */ 

end ; 
e lse 
do ; 

if not var iantSpart(recGnst) then 
do ; 

var i an t Spar t ( recSns t ) = true ; 
var ScasS t p ( recSns t ) = typeS loc t ; 
varScasSva 1 ( recSns t ) =a 1 lcS indexSo f f se t ; 
call a 1 lcSo f f se t ( typeS loc t ) ; 

If tagSfd( recSns t > then 
do ; 

t agSf d ( recSnst) = f a lse ; 
base=recSaddr ( recordSptr ) ; 
call se taddrp tr ( 4) ; 
by t ep tr = 9 f h; 
call se taddrp tr( 5) ; 
call se taddrp tr( 8+byteptr) ; 
addrp t r = varSc asSva 1 ( recSns t ) ; 
aptraddr = ap trad dr +2; 
addrp tr=varScasS tp( recSns t) ; 
ap t raddr = ap trad dr +2 ; 
addrp tr=curSo f s t C recSns t ) ; 
curSofs t( recSns t ) = cur So f s t ( recSns t)+allcSqty; 
end ; 

var So f s t Sbse ( recSns t ) = cur So f s t ( recSns t ) ; 
fxdGo fs tSbse( recSns t ) =curSo f s t( recSns t ) ; 
end ; 

/% call compareScons tSvar ian t ; 

the routine above checks the case lable with the variant type 

curSofs t ( recSns t ) = var So fs tSbse ( recSns t ) ; 
veep tr = veep tr- 1 ; 

cons tSptr , cons tSindx, cons tSpnSptr = 0 ; 
end ; 



/* 77 


< se t t ype> : 


: = set of <base type> 


*/ 


call enterSs true tS type ( 27h) ; 




/* 73 

* 


<base type> 


: : = < simple type> 


*/ 


79 


< f i le type> 


: : = file of < type> 


*/ 



call enterSs true tS type ( 2fh) ; 
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80 <po inter type> ::= 0 < type ident> 

call enterOs true tO type ( 37h) ; 


%/ 


/* 


81 


< vdp> : : = 


X/ 


/X 


82 

» 


1 var < var dec lar string) ; 


X/ 


/% 


83 


< var dec lar string) ::= <var dec lar> 


X/ 


/X 


84 


1 <var declar string) ; 


X/ 


/X 


84 

» 


<var declar) 


X/ 


/X 


65 


„ < var dec lar) < ident var s t r i ng> • < type> 


X/ 



do ; 

call a 1 lcSo f f se t ( type© loc t ) ; 



if not allocate then 
do ; 

a 1 lcSqt y= 1 ; 
allcSbasicS type = 0 ; 
end ; 

do whi le varSptr <> -1; 
base = varSbase ( varSp tr) ; 
call so taddrp tr ( 4) ; 

bytep t r = shl ( a 1 lcSbas icS type , 3) or varSentry; 
aptraddr= varSbase 1 ( varSp tr) ; 
addrptr=al loc Sad dr ; 
a 1 locSaddr=a 1 locSaddr+a 1 IcOqty; 
ap traddr=ap traddr+2 ; 
addrptr = typeS loc t ; 
varSp t r = varSp tr- 1 ; 
end ; 
end ; 



/X 86 < ident var str ing> :•= < identified X/ 

do ; 

varSp t r = 0 ; 

va r Ob a s e = s b t b 1 ; 

call enterOvarS id( 0, sp, varSentry) ; 
ca 11 limits (4); 
var 8b as e l = sb tb 1 ; 
sb tb l = sb tb 1+4; 
end ; 

87 I < ident var str ing> , 

87 < ident if ier> */ 

do ; 

if varSptr <> 10 then 

do ; 

var Op tr = varSp tr+ 1 ; 
var Ob as e ( varSptr) = sb tb 1 ; 
call en terOvarS id ( 0, sp, varSentry) ; 
call 1 imi t s ( 4) ; 
var Ob as e 1( varSptr) S sb tb 1 ; 
sb tb 1 = sb tb 1+4 ; 
end ; 

else call error(’vn’); 





end ; 








/X 


88 


<p8fdp> ::= 




X/ 


? 

/X 


80 


1 <porf 


dec lar> 


X/ 


/X 


90 


<porf dec lar) * ; = 


<proc or funct> ; 


X/ 


* 

/X 


91 


1 


<porf declar) <proc or funct> ; 


X/ 


/X 


92 


< proc or funct> » 


: = < procedure declaration) 


X/ 


? 

/X 


93 




1 < func t ion dec lar> 


X/ 
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/X 

/X 




94 

94 


< procedure declaration ::= < procedure headlng> 

< b lock> 


X/ 

X/ 


/* 




95 


< procedure heading> <proc id> ; 


X/ 


/X 


? 


96 


1 <proc ld> ( 


X/ 


/X 


; 


96 


< formal para sect 1 Is t> ) ; 


X/ 


AX 


? 


97 


< proc id> : : = procedure < identified 


X/ 


/X 




98 


< forma 1 para sect list> < formal para sect> 


X/ 


/X 


» 


99 


1 < formal para sect list> ; 


X/ 


/X 


» 


99 


<formal para sect> 


X/ 


/X 




100 


< formal para sect) 2 : = <para group) 


X/ 


/X 


» 


101 


1 var <para group) 


X/ 


/X 


» 


102 


1 function < para group> 


X/ 


/* 


» 

5 


103 


1 procedure <proc ident list> 


X/ 


/X 




104 


<proc ident list> 2 : = <identifier> 


X/ 


/X 


5 

? 


105 


1 < proc ident list> , <identifier> 


X/ 


/X 


? 


106 


<para group) 2 2 = <para ident list> : < type ident> 


X/ 


/X 




107 


<para ident list> 2 : = <identifier> 


X/ 


/X 


» 


108 


1 < para ident list> , <identifier> 


X/ 


/X 


5 


109 


< function dec lad : : = < function heading> <block> 


X/ 


/* 




110 


< function heading> 2 : = < func t id> 5 < result type> ; 


X/ 


/X 


' 


111 


1 < func t ld> ( 


X/ 


/X 




111 


< formal para sect list> ) : 


X/ 


/X 


? 


111 


<result type> ; 


X/ 


/X 




1 12 


<funct id> function < ident if ier> 


X/ 


/X 


? 


113 


< resul t type > 2 2 = < type ident> 


X/ 


/X 


? 


114 


<stmtp> 2 : = < compound stmt) 


X/ 


/X 




1 15 


<stmt> <bal stmt) 


X/ 


/X 


» 


116 


1 <unbal stmt) 


X/ 


/X 


? 


1 17 


1 < label de f > <stmt> 


X/ 


/X 


do ; 


118 


< ba 1 stmt) < if clause) < true part> else <bal stmt) 


X/ 




call genera te( lb 1 ) ; 
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/ V 



call genera te ( low< ifSlbK if$ptr)+l) ) ; 
call genera te( high( ifSlbK ifSptr) +1) ) • 
i f Op t r = i f Sp t r- 1 ; 
end ; 

I < s i mp 1 e s t m t > 



*/ 






/* 

/X 



120 <unbal stmt> <lf clause) <stmt> 

do ; 

call genera te ( lb 1) ; 

call genera te( low( ifSlb 1( ifSptr) ) ) ; 
call genera te( high ( i f S lb 1( i f Sp tr ) ) ) ; 
i fOp tr= i f Sp tr- 1 ; 
end ; 

121 I <if clause> < true part> else 

121 < unba 1 strat> 

do ; 

call genera te( lb 1) ; 

ca 1 1 genera te( low( ifSlbK ifSptr)+l) ) ; 
call genera te( hi gh( ifSlbK ifSptr)+l) ) ; 
i f Sp t r = i f Sp tr- 1 ; 
end ; 



122 <if c lause) i i “ <if> < express ion) then 

do ; 

if expStype ( expSp tr) =boo leanS type then 
do ; 

expSp tr=expSp tr- 1 ; 
call genera te ( no tx) ; 
call genera te( b lc) ; 

call genera te ( low( ifSlbK i f Sptr ) ) ) ; 
call genera te( high( if Sib 1( ifSptr) ) ) ; 
end ; 

else call error( ’ce’) ; 
end ; 

123 < if> : if 

do ; 

if ifSptr=9 then 
do ; 

call error( ' io’) ; 
call mo n3 ; 
end ; 

if$ptr=ifSptr+l; 
ifSlbK i fSp tr ) = lab lcount ; 
lab lcount = lab lcount=2; 
end ; 

/X 124 < true part> • - <bal stmt) 

do ; 

call genera te ( br 1 ) ; 

call genera te ( low( ifSlbK if$ptr)+l) ) ; 
call genera te ( high( ifSlbK i fSp tr ) + 1 ) ) ; 
call generate(lbl); 

call genera te( low( ifSlbK ifSptr))) ; 
call genera te( high( ifSlbK ifSptr))) ; 
end ; 

/* 125 < label def> = <label> : 

if lookup$pn$id( mp , lab lSentry) then 
do ; 

call se taddrp tr ( 5) ; 
call se taddrp tr( 6+byteptr) ; 
call genera te( lb 1) ; 
call genera te ( low( addrp tr) ) ; 
call genera te ( high( addrptr) ) ; 
end ; 

else call error(*ul*); 

/X 126 < s imp le stmt) = <assignment stmt) 

* 

/% 127 I <procedure stmt) 



*/ 



X/ 

X/ 



X/ 



X/ 



X/ 



X/ 



X/ 

X/ 
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♦ 


128 


1 


<repetltlve stmt> 


%/ 


f 


129 


1 


(case stmt> 


%/ 


» 


130 


1 


< wi th s tmt> 


%/ 


♦ 


131 


1 


<read stmt) 


%/ 


/* 


132 


1 


<wrlte s tmt > 


*/ 


? 

♦ 


133 


1 


<goto stmt) 


%/ 


1 


134 


1 


< compound stmt) 


*/ 


» 

♦ 

f 


135 


1 




%/ 




136 


< assignment stmt> 


::= <var iable) : = <expression> 


*/ 



do ; 

call genera te ( 1 i ta) ; 

call genera te( low( varSbase( varSptr) ) ) ; 
call generate( high( varSbase( varSptr) ) ) ; 
do case expS type ( expSp tr ) ; 

/* case 0 - ord type */ 

If var S type ( varSp tr ) < > 1 lh or expG typeSaddr ( expSp tr ) ( > 

varSbase 1 ( varSp tr ) then 
goto errorSloop; 
else call generate(std); 

/* case 1 - integer type */ 

If varS type ( varSp tr) = 09h then 
call genera te( s td i ) ; 
e lse do ; 

if var C type ( varSptr) =0ah then 
do ; 

call genera te ( cna i) ; 
call genera te ( s tdb) ; 
end ; 

else goto errorSloop; 
end ; 

case 2 - charStype 
if varS type ( varSp tr) =0bh then 
call genera te( s td) ; 
else goto errorSloop; 

/% case 3 - real type 
if varS type (varSptr) =0ah then 
call genera te( s tdb ) ; 
else goto errorSloop; 

/% case 4 - string type 
; /% not implimented */ 

/% case 5 - boolean type */ 
if varS type (varSptr) =08h then 
call genera te( s td) ; 
else goto errorSloop; 
end; /* of case 
goto secondSloop; 

errorSloop: call error(’at’); 

secondSloop: 

expSptr=expSptr- 1 ; 
varSp tr = var $p tr- 1 ; 
end ; 



/% 


137 


<var iable) :: = <entlre var 


lab le> 




? 

/% 


138 


1 <varlable> 


S 


*/ 


/* 


139 


1 <variable> 


< lp> (expres llst> <rp> 


*/ 


? 

/* 


140 


1 < va r 1 a b 1 e > 


. (field iden t> 


*/ 




141 


< en t Ire variable^ ::= (variable idenO 


*/ 
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< ident i f ier> 



142 < var iab le idenO • • = 

if not lookupSonly( sp) then 
call error ( ’ d t 1 ) ; 
e lse do ; 

call se tSvarS type ; lookupSaddr set 
end ; 



here */ 



*/ 



/X 


143 


<expres list> 


5 : s < express ion> 


X/ 


/X 


144 




1 <expres list> , <expression> 


X/ 


/X 


145 


< express ion> : 


:s <simple expression) 


X/ 


/X 


146 




1 <simple expression) 


X/ 


/X 


146 




<re lat ional operator) 


X/ 


/X 


146 




<simple expression) 


X/ 



do ; 

opSp tr =opSp tr- 1 ; 

if checkSexprsStype then 
do ; 

i f ( expS type ( expSp t r ) < > 4h) or ( expStype( expSp tr) < > 3h) then 
do case ( opS type ( opSp tr ) -8h) ; 

/* case 0 - * */ 
call genera te( e ql i ) ; 
call generate(neqi) ; 
call generate( leqi) ; 
call generate(geqi) ; 
call genera te ( lss i ) ; 
call genera te ( gr t i ) ; 

; "in" not impliraented 

end; of case for integers %/ 

if expStype( expSp tr ) = 3h then 
do case ( opStype ( opSp tr ) -8h) ; 
call genera te ( e qlb ) ; 
call genera te ( ne qb) ; 
call genera te ( le qb ) ; 
call genera te ( ge qb) ; 
call genera te ( lssb ) ; 
call genera te ( gr tb) ; 

; /X "in" not implemented */ 
end; /X of case for reals */ 
if expS type ( expSp tr ) =4h then 

do ; /X tests for strings not irapl imented X/ 
end ; 

expS t ype ( expSp tr ) =boo leanS type ; 
end ; 

else call error(’ce’); 

expSptr- expSp tr- 1 ; 
end ; 



/* 147 < re la t iona 1 operator) ::= • */ 

do ; 

opStype ( opSp tr ) s 08h; 

opSp t r = opSp tr+ 1 ; next to fill */ 

end ; 

/* 148 I < > */ 

do ; 

opStype ( opSptr) = 09h; 

opSpt r=opSptr+ 1 ; 
end ; 

/* 149 I < = %/ 

do ; 

opStype ( opSptr ) =0ah; 

opSp tr = opSp tr + 1 ; 
end ; 

/* 150 I > = */ 

do ; 

opStype( opSptr) -Obh; 

o pSp t r = o pSp tr + 1 ; 
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/X 

/* 

/* 

/* 

/X 



/X 

/X 



end ; 

151 

do ; 

opS type ( opSp tr ) =0ch; 
opSp tr 3 opSptr + 1 ; 
end ; 

152 

do ; 

opS type ( opSp tr ) = 0dh; 
opSp tr = opSp tr+ 1 ; 
end ; 

153 

do ; 

opStype( opSptr ) =0eh; 
opSp tr = opSp tr + 1 ; 
end ; 

154 < term> = <factor> 

* 

1^5 I < term> Multiplying operator> < factor) 

do ; 

opSp tr=opSptr-l; 
if checkSesprsS type then 
do; 

If opS type ( opSptr )= Oh then /X multiplication X/ 
do case expStype( expSptr ) ; 
call error('ce’); /X case 0 - ord X/ 
call genera te ( mu 1 i ) ; /X case 1 - integer X/ 
call error ( * ce * ) ; 

call genera te ( mu lb ) ; /X case 3 - real X/ 
call error(’ce’); /X case 4 — string X/ 
call error(’ce’); /X case 5 - boolean X/ 
end; /X of mul case X/ 

if opStype( opSptr )- lh then /X real division X/ 
do case expS type ( expSp tr ) ; 
call error(’ce’); /X case 0 - ord X/ 
do; /X case 1 - Integer with real result X/ 
call genera te( cnvi ) ; /X convert 1st Integer X/ 
call genera te ( cn2 i ) ; /X convert 2nd integer X/ 
call genera te ( d Ivb) ; 
expS t ype ( expSptr- 1) 3 uns ignSexpon; 
end ; 

call error(’ce’); /X case 2 - char X/ 
call genera te ( d ivb) ; /X case 3 - real X/ 
call error(’ce’); /X case 4 - string X/ 
call error(’ce’); /X case 5 - boolean X/ 
end; /X of div case X/ 

if opS type ( opSp tr ) =2h then /X Integer divide X/ 

If expS type ( expSptr ) 3 integerStype then 
call genera te ( d ivi ) ; 
else call error( ’ce’) ; 

If o pS t ype ( opSptr) 3 3h then /X integer mod X/ 
if expS type( expSp tr) 3 integerStype then 
call genera te ( dcr i) ; "mod" not implimented X/ 

else call error( ’ce’) ; 

if opS type( opSp tr) =4h then /X boolean and X/ 
if expS type ( expSptr) 3 boo leanS type then 
call genera te ( andx) ; 
else call error (’ ce *) ; 
end ; 

else call error( 'ce' ) ; 
expSp tr 3 expSp tr- 1 ; 
e nd ; 

156 < mu It i p 1 y 1 ng operator) ::= X 

do ; 

opS type ( opSptr) =0h; 
opSp tr=opSptr+ 1 ; 
end ; 

157 I / 

do ; 

opS type( opSptr) =0 lh; 



I < 



I > 



I in 



X/ 



X/ 



X/ 



X/ 

X/ 



X/ 



X/ 
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d i v 



opSp tr=opSptr+ 1 ; 
end ; 

/* 158 

do ; 

opS type ( o pSp tr ) =02h; 
opSp t r = o pGp tr+ 1 ; 
end ; 

/* 159 

do ; 

opS type (opSptr) = 03h; 
opSptr=opOp tr+ 1 ; 
end ; 

/* 160 

do ; 

opS type ( opSptr) = 04h; 
op8p tr = opSp tr+ 1 ; 
end ; 



I mod 



I and 






161 <slmple expression ::= < term> 



< s ign> < term> 



then 



<simple expression 
<adding operator> < terra) 



/* 162 

if signtype = neg then 
do ; 

if expS type ( expSp tr) S uns ignSexpon then 
call generate(negb) ; 
else if expG type ( expSp tr) = integers type 
call generate(negi) ; 
else call error( ’uo’> ; 
end ? 

✓* 163 I 

/* 163 

do ; 

opSp tr = opSptr- 1 ; 
if checkSexprsS type then 
do ; 

if opS type< opSp tr ) =5h then arith add 
do case expG type ( expSp tr) ; 
ca 1 1 error ( * ce * ) ; 

call genera te ( add i ); /% case 1 - Integer 
call error(’ce’); case 2 - char %/ 

call genera te ( addb ) ; /* case3 - real %/ 
call error (’ ce * ) ; case 4 - string */ 

call error(’ce'); /* case 5 - boolean 

end; /* case */ 



if opStype ( opSptr ) = 6h then 
do case expS type ( expSp tr) ; 
call error(’ce’); case 

genera te ( sub i ) ; 
error ( ’ce’) ; 
call genera te ( subb ) ; 
not implimented 
error ( ’ce’) ; 
error ( ’ce’ ) ; 



arith subtrc 
0 - ord type %/ 



call 
call 

; call erenera te ( subb ) ; 

/% 
call 
call 
end ; 

if opS type ( opSp tr) =7h then boolean or 
do ? 

if expStype ( expSp tr) =boo leanStype then 
call genera te( bor) ; 
else call error(’ce’); 
end ; 
end ; 

else call error(’ce’); 
expSp tr = expSp tr- 1 ; 
end ; 



164 <adding operator) 

do ; 

opS type ( opSp tr) =05h; 
opSp tr = opSp tr + 1 ; 
end ; 

/* 165 

do ; 



*/ 



*/ 



*/ 



*/ 

*/ 



*/ 



*/ 



*/ 
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opS type ( opSptr) = 06h; 
opSp t r=op3p tr+ 1 ; 
end ; 

/* 166 
do ; 

opS type ( opSptr ) -07h? 
opSp tr = o pOp tr+ 1 ; 
end ; 



%/ 



167 < fac tor> t:= <variable> 

do ; 

if expSptr-11 then 
do ; 

call er ror ( * es * ) ; 
call mo n3 ; 
end ; 

expSp tr =expSp tr+ 1 ; 
call loadSvar iab le ; 
end ; 





168 


1 <variable> ( <actual para list> ) 


*/ 


/* 


169 


1 ( < express ion> ) 


*/ 


* 

/* 


170 


1 < se t > 


*/ 


* 

/* 


171 


1 not < f ac tor> 


X/ 



if expO type( expGptr) =boo leanS type then 
call genera te ( no tx) ; 
else call error(’ce’); 



172 l <number> %/ 

do ; 

if expGp tr = 1 1 then 
do ; 

call error ( ’ es ’ ) ; 
call mo n3 ; 
end ; 

expSp tr = expSp tr + 1 ; 
if typenum = in tegerS type then 
do ; 

expO type ( expSp tr) = integers type ; 
a 1 lcSqty=conver ti(sp,pos) ; 
call generate(ldii); 
call genera te( low( a 1 lcSqty) ) ; 
call genera te ( high( a 1 lcSqty) ) ; 
end ; 

else do ; 

expS type ( expSp tr) = uns ignSexpon; 
call convr tbcd( sp , pos) ; 
call genera te ( Id ib) ; 
do ptrptr=0 to bcdsize-1; 

call genera te ( bcdnum( ptrptr) ) ; 
end ; 
end ; 
end ; 



/X 


173 


1 nil 


X/ 


/X 


174 


l <string> 


X/ 


/X 


175 


< actual para list> < actual para> 


X/ 


» 

/X 


176 


1 < actual para list> , 


X/ 


/X 


176 


< actual para> 


X/ 


/X 


177 


<set> ::= < lp> <element list> < rp> 


X/ 


/X 


178 


<element list> • • = 


X/ 


/X 


179 


1 <xelement list> 


X/ 



177 





189 


< xe 1 e me n t list> :: = <element> 


X/ 




181 


1 <xe lenient llst> , < element > 


X/ 


/* 


182 


<element> = <express ion> 


X/ 


/X 


183 


1 < express ion> .. <expression> 


X/ 


/X 


184 


<goto stmt> <goto> <label> 


X/ 




if lookupSpnS id( sp , lab lSentry) then 






do ; 
call 


se taddrp tr ( 5) ; 






call 


se t addrp tr ( 6 + by tep tr ) ; 






call 


genera te( low( addrp tr) ) ; 






call 
end ; 


genera te ( high( addrptr) ) ; 






e lse do ; 






call 


er ror ( * ul * ) ; 






call 


genera te ( nop) ; call genera te ( nop) ; 






end ; 






/X 


185 


< go to > : ! 3 go to 


X/ 




call genera te ( br 1 ) ; 




/* 


186 

5 


<compound stmt> : •* 3 <begin> <stmt list s> end 


X/ 


/X 


187 

5 


< begin> : : 3 begin 


X/ 


/X 


188 


<stmt lists> : : 3 <stmt> 


X/ 


/X 


189 


1 <stmt lists> ; <stmt> 


X/ 


/X 


190 


<procedure stmt> : := <procedure ident> 


%/ 


/X 


191 


1 < procedure ident> ( 


X/ 


/X 


191 


< actual para list> ) 


X/ 


/X 


192 

i 


<procedure ident> ! i 3 <identifier> 


X/ 


/X 


193 

9 


<actual para> <expression> 


X/ 


/X 


194 


< rec variable list> : : 3 <variable> 


X/ 


/X 


195 


1 <rec variable list> , 


X/ 


/X 


195 


< var iab le > 


X/ 


/X 


196 


< read stmt> ;:= <read head> ( < io list> ) 


X/ 


/X 


197 


<read head> ' • 3 read 


X/ 




do ; 








wr ite§stmt 3 false ; 
a 1 loca te 3 f a lse ; 




/X 


end ; 
198 

do ; 


1 readln 


X/ 




wr ite$stmt 3 false; 
a 1 locate 3 true ; 






end ; 







199 <write stmt> <write head> ( < io list> ) 

if allocate then call genera te ( dump) ; 

200 I <write head> 
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if allocate then call genera te ( dump) ; 

201 < write head> ::= write 

do ; 

a 1 loca te= fa lse ; 
wr i teSs t rat = true ; 
end ; 

202 I write In 

do ; 

al locate 2 true ; 
wr i teSs tmt= true ; 
end ; 



/* 


203 < io 1 is t> 


• • s < f i le ident> * , 


, < var list> 


*/ 




not implimented 








/* 


204 

? 


1 <var list> 




*/ 


/* 


205 <var list> 


: : = < var iab le> 




*/ 



if writeSstmt then call writeSvar; 
else call readSvar; 

206 I <string> */ 

if writeSstmt then call wr i teSs tr ing; 

else do; not implemented X/ 

end ; 

/* 207 f < var list> , <variable> 

if writeSstmt then call writeSvar; 

else call readSvar; 

/% 208 I < var list> , <string> */ 

if writeSstmt then call wr i te$s tr ing; 

else do; /* not implimented */ 
end ; 



/X 

/X 

? 


209 

209 


< case 


s tmt > i i = 


<case espress> <case 
end 


list e lerat 1 is t> 


*/ 

*/ 


/X 


210 


< case 


espress> 


::= case < express ion> 


of 


*/ 



do ; 

caseSs tmt = true ; 
end ; 



/X 


211 


<case list e lemt list> ! '•= <case list 


e lement> 


X/ 


/X 


212 


1 <case list 


e lerat 1 is t> ; 


X/ 


/X 

t 


212 


< case list 


e 1 e rae n t > 


X/ 


/* 


213 


<case list e lement> 




X/ 


/X 


214 


1 <case label list> *• <stmt> 


X/ 


/X 


215 


< repetitive stmt> •' • - < whi le stmt> 




X/ 


t 

/X 


216 


1 <repeat strat> 




X/ 


/X 


217 


1 < for s tmt > 




X/ 


/X 


218 


<with s tmt> = <with> <rec variable 


1 is t > < do> 


X/ 


/X 


218 


< ba 1 s tmt > 




X/ 


/X 


219 


< wi th> • • = with 




X/ 


/X 


220 


< do > : := do 




X/ 


/X 


221 


< while stmt> : : = <while> < express ion> 


<do> <bal stmt> 


X/ 
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/* 


5 


222 


< whi le> : : = whi le 




X/ 


# X 
\ \ 


* 


223 

223 


< for stmt> ::= < for> <control variable> 
< do> < ba 1 s t mt > 


• = < f or 1 is t> 


X/ 

X/ 


/% 


♦ 


224 


^ for) i i = for 




X/ 


/X 




225 


< for 1 is t > ::= < initial value) < to> <final value) 


X/ 


/X 


? 


226 


I < initial value) <downto> 


< f i na 1 value) 


X/ 


/X 


? 


227 


< con tro 1 var iab le> ::= <identifier> 




X/ 


/X 


? 


228 


.< initial value) ::= < express ion) 




X/ 


/X 


• 

« 


229 


< final value) ::= < express ion) 




X/ 


/X 




230 


< repea t stmt) ::= <repeat> <stmt lists> 


< un t i 1 > 


X/ 


/X 


do : 


230 

1 


< express ion) 


X/ 





re pea tSp tr = re peat Sptr-1 ; 

if ezpS type ( expSptr) =boo leanStype then 
do ; 

expSp tr=expSptr- 1 ; 
call genera te ( no tx) ; 
call genera te( b lc) ; 

call genera te( low( repea t$ lb 1 ( repea tSptr) ) ) ; 
call genera te ( hlgh( repea tS 1 b 1 ( repea tSp tr) ) ) ; 
end ; 

else call error(’ce’); 
end ; 

231 <repeat> repeat %/ 

do ; 

call genera te ( lb 1 ) ; 
call genera te( low( lab lcount) ) ; 
call genera te ( high( lab lcount )) ; 
repeat$lbl(repeatSptr)= lab lcount ; 
lab lcount = lab lcount + 1 ; re pea tSptr = repe a tSp tr+ 1 ; 
end ; 



/X 


232 


< un 1 1 1> : : = 


unt i 1 


X/ 


/X 


233 


< to> : : = to 




X/ 


/X 


234 


< downto) : : = 


dovmto 


X/ 


/X 

? 

end ; 


235 


not used, 


overflow indicator 


X/ 

/X of case statement X/ 



end s yn t he s 1 z e ; 



/XXX error recovery rout ines ***/ 
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noconflict! proc (estate) byte; 

del estate statesize, ( i , J , k) indexsize; 
J s indexl ( cs ta te ) ; 
k= J + index2(cstate) - 1; 
do i = J to k; 

if readl( i) = token then return true; 
end ; 

re turn f a lse ; 
end noconf 1 ic t ; 



recover! proc statesize; 

del tsp byte, rstate statesize; 
do forever; 
tsp = sp ; 

do while tsp <> 255; 

if noconf 1 ic t ( rs ta te i =s ta tes tack! tsp) ) then 

do; /X state will read token 

if sp <> tsp then sp = tsp - 1; 
return rstate; 
end ; 

tsp = tsp - 1; 
end ; 

call scanner ; 
end ; 

end recover; 



/ 4% ^ ^ <T* *T* ^ ^ ^ < T» ^ /f* ^ V ^ ^ ^ ✓,> /f* #ffc ^ #fs r[s rJS #f> »,S ^ /p / 

/*** lair parser routines ***/ 

/ 2fC2f€ 2fC /fC 5fC 5f> 5yC5fC 2fC ^fC #fC 2f£2f£ JfCJjC *fC2if€ 5fC 5fC ^ ^ SifC )fC 5fC JfC <fC 2^€*fC 5fC #j» #fC JfC / 

/ ^ <fC rfC 2f£2i(2fC2f( ^ ^ #fwfC^ 5fC5f> SfC/ 



do; /tfblock for declarations^/ 

del ( i , J , k) indexsize, index byte; 



ini t ia 1 ize : proc ; 

call initializeSscanner; 
call in i t ia 1 izeSsymtb 1 ; 
call ini t ia 1 izeSsynthes ize ; 
call title; 
end initial ize ; 



get ini! proc indexsize; 

return indexl ( s ta te ) ; 
end ge t ini ; 



getin2: proc indexsize; 

return index2( s ta te ) ; 
end ge t in2 ; 



inesp: proc; 

if (sp sp + 1) = length! s ta tes tack) then 

call error! ’ so * ) ; 

end inesp; 



lookahead! proc; 

if no look then 
do ; 

call scanner ; 
no look = false; 
if listtoken then 

call printSto ke n ; 

end ; 
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end lookahead; 



setSvarcGi ! proc(i); /He set varc, and incrmnt var index He/ 

del 1 byte; 
varc( var Index) = 1 ; 

if ( var index: = var index* 1) > length(varc) then 

call error ( ’ vo 1 ) ; 
end setSvarcSi; 



/He initialize for input - output operations He/ 
call mo ve ( . r f cb , . wf cb , 9 ) ; /He put filename in write feb He/ 

call se tupS int Sf i le ; /He creates output file for generated code He/ 
call initialize; 

do forever; 

do while true; /He initialize variables He/ 

comp i 1 ing, no look= true ; 
s ta te = s tarts ; 
sp= 255 ; 

var index, var = 0; 



do 



while compiling; 

If s ta te< = maxrno then /He read state He/ 

do ; 

call inesp; 
statestack(sp)=state; 
l = ge t ini ; 
call lookahead; 



J= i+get in2- 1 ; 
do i= i to J ; 

if read 1( i ) = token then /He save token He/ 

do; /He copy accum to proper position He/ 

va r ( s p ) = va r index; 
do index = 0 to accum; 

call set$varcOi(accuin( index) ) ; 
end ; 

hash(sp) = hashcode; 

/He save relative table location He/ 
state=read2( i ) ; 
no look= true ; 



1 = J 1 
end ; 

else if i = J then 
do ; 

call error(’np’); 
if (state := recover) =0 then 
compiling = false; 

end ; 



e 



/He apply production state 



end ; 

end ; 

se if state>maxpno then 
do ; 

mp=sp-ge t ln2 ; 
mpp 1 = mp+ 1 ; 

production = s ta te—maxpno ; 

call synthesize; 

sp=mp ; 

i = ge t ini ; 

var lndex= var ( sp) ; 

j = statestack(sp) ; 

do while ( k: =applyl( i) ) <> 0 and J <> k; 

1= i+1? 
end; 

if (stated apply2(i))=0 then compiling = false; 

end ; 

else if s ta te< = maxlno then /* lookahead state He/ 

do : 



i = ge t ini ; 
call lookahead; 

do while ( k: = lookl( 1) ) <> 0 and token <> k; 



He/ 
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end ; 
end ? 
end ; 



i 3 1+ 1 ; 
end ; 

state 3 look2( 1 ) ; 
end ; 



e lse 



push state 

do ; 

call incsp; 

statestack(sp)= getln2; 
state 3 getinl; 
end ; 

of while compiling 
/*o f while true 

/*of do forever^/ 



*/ 

*/ 



end ; 
end ; 
eo f 



/* of block, for parser */ 
/*of block for declarations^/ 
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1 OOh • 



/#load point for translator*/ 



/************************************************** 
/************************************************** 
/*** system literals 

/************************************************** 
/************************************************** 



* ************* * * * * * * / 
************* ** *****/ 
***/ 

* ******* * ******** * * */ 
********************/ 



lit 1 i tera 1 ly 


1 1 i tera 1 ly ’ 


dc 1 


lit 


’ dec lare ’ , 


proc 


lit 


’ procedure ’ 


bdos 


lit 


’oh’ , 


boo t 


lit 


’0’ , 


true 


lit 


’ i’ , 


addr 


lit 


* address ’ , 


false 


lit 


’0’ , 


bcdG len 


lit 


’3’ , 


intO 1 en 


lit 


’2’ , 


f i leeo f 


lit 


’ r , 


comrecs ize 


lit 


’ 123’ , 


eoffiller 


lit 


’ lab.’ , 


p inrecs ize 


lit 


’ 128’ , 


f o r e ve r 


lit 


’ wh i 1 e true 



/Gentry point to disk op. sys*/ 
/* esit to return to op. sys . */ 



dc 1 



dc 1 



sbloc 


addr 


codes tr t 


addr 


vars tr t 


addr 


progOs ize 


addr 


nextehar 


byte , 


codecount 


addr 


varcount 


addr 


genObuf f ( 80) 


byte , 


codes ize 


addr 


tempaddr 


addr , 


tempbyte 


byte , 


c o mb u f f ( co mr e c s ize) 


p inp tr 


byte 


erreoun t 


addr 


p incode 


byte , 


pinbuf f 


based 


s t ar tbdos 


addr 


base 


addr , 


mas 


based 


comptr 


byte 


curpinrecs ize 


byte 


r f cbaddr 


addr 


loop 


byte , 


wf cb( 33) 


byte 


r f cb 


based 


espe (66) 


byte , 


espaddr ( 66) 


addr , 


spOmax 


addr , 


no look 


byte ; 


pass 1 


addr 


pass2 


byte 


nopinfile 


byte 



ini t ia 1( 80h) , 
ini t ia 1 ( 0) , 
in i t ia 1 ( 140h) , 
ini t ia 1 ( 0) , 

initial(O) , 
ini t ia 1 ( 0) , 

initiaK 100b.) , /# adds bytes generated */ 



byte , 

initialCpinrecsize) , 
ini t ia 1 ( 0) , 

sbloc (pinrecsize) byte, 

initial(6h), /#ptr to addr of bdos*/ 

startbdos addr, 
initiaK 255) , 
ini t ia 1( p inrecs ize ) , 
initiaK 5c b) , 

initiaKO, ’ ’ , ’com’ ,0,0,O,0) , 

r f cbaddr ( 33) byte, 



/* stack pointer max */ 



initiaK true ) , 
ini t ial( false) , 
ini t ial( false) ; 



global procedures 

************«************************************************* / 



monl • proc ( f , a) ; 
del f byte, 
a addr ; 
go to bdos ; 
e nd mo n 1 ; 
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mon2: proc (f,a) byte; 

del f byte, a addr; 

go to bdos ; 
end mon2; 



deleteOfilei proc(a); 
dc 1 a addr ; 
call monl(19,a); 
end de le teGf i le ; 



makeCfile: proc (a) byte; 
dc 1 a addr ; 
return mon2(22,a); 
end ma ke G f i 1 e ; 



setGdma: proc (a); 
dc 1 a addr ; 
call mon 1 ( 26 , a) ; 
end setCdraa; 



wr tScomSr erd • proc(a) byte; 
dc 1 a addr ; 
return mon2(2l,a); 
end wrtCcomOrcrd; 



closeSfile* proc(a) byte; 
dc 1 a addr ; 
return mon2(16,a); 
end closeOfile; 



openGfile: proc(a) byte; 

del a addr ; 
return raon2(15,a); 
end openGfile; 



readGflle: proc(a) byte; 

del a addr ; 
return mon2(20,a); 
end readOfile; 



de le teOp inOf i le : proc; 

call de le teOf i le( rfcbaddr ) ; 
end de le teGp inOf 1 le ; 

move: proc (a,b,l); /Amoves fm a to b for 1 bytes 

del ( a , b) addr, /* 1 < 255 bytes */ 

Cs based a, d based b,l) byte; 
do while (1:=1 - 1) <> 255; 

d = s ; 

b=b + 1; 

a = a + 1 ; 

end ; 

end move ; 



pr int : proc ( a) ; 

dc 1 a addr ; 

call mo n 1 ( 9 , a ) ; 
end print; 



printchar: proc(rnsg) ; 

dc 1 msg byte ; 
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call monl(2,msg); 
end pr intchar ; 



error? proc ( errcode ) ; 
del errcode addr, 
i byte; 

erreount = erreount + 1; 
call pr int ( . * * ) ; 
call print(.* errorG’) ; 
call printchar( ’ *); 

call pr intchar ( hi gh< errcode) ) ; 
call pr intchar ( low( errcode )) ; 
end error; 



d iskerr : proc ; 

do ; 

call print(.*disk error 0 1 ); 
go to boo t ; 
end ; 

end diskerr; 



file manipulating* routines ***/ 



se tupCcomCf i le * proc ; 

if nopinfile then /# only make file if this toggle off */ 
re turn ; 

call mo ve ( . r f cb , . wf cb , 9) ; 

wf cb ( 32) = 0; 
call de le teOf i le( . wfeb) ; 
if make£>file( .wfeb) = 255 then 
call diskerr; 
end set up 3c o mC file; 



wr iteGco m3 file? proc; 
if nopinfile then 
re turn; 

call se tCdznaC . combuf f ) ; 
if wr tOcomGrcrdC . wfeb ) <> 0 then 
call d iskerr ; 

call setGdma(sbloc) ; /* reset dma addr */ 

end wr i teOcomSf i le ; 



emit: proc ( objeode ) ; 

del objeode byte; 

if (comptr := comptr+1) >= comrecs ize then 
/# write to disk */ 
do ; 

call wr i t eCcomOf i le ; 
comptr = 0 ; 
end ; 

combuf f ( comp tr) = objeode; 
end emit; 



generate: proc ( objeode ) ; 

del objeode byte; 

codesize = codes ize+1 ; 
call emi tC objeode ) ; 
end generate; 



genSf ive : proc ( a , b , c , d » e ) ; 

del (a,b,c,d,e) byte; 
codesize = codesize + 5; 
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call emit(a) 
call emi t ( b ) 
call emi t ( c ) 
call emit(d) 
call emit(e) 
end g’enCf i ve ; 



gten: proc(a 1 b,c,d,e 1 f , £,h, i, j) ; 

del (a,b,c,d,e,f,g,h, i,j) byte; 
codesize = codesize + 10; 
call emit(a); 
call emit(b); 
call emi t ( c ) ; 
ca 11 emit(d); 
call emit(e); 
call emit(f); 
ca 1 1 emi t ( gO ; 
call emi t ( h) ; 
call emi t C i ) ; 
ca 1 1 emi t ( j ) ; 
end gten; 



c loseOcomOf i le • proc ; 
closes a file 

if c loseOf i le( .wfeb) = 255 then 
call diskerr; 
end c loseOcomOf i le ; 



openOp inOf i le : proc; 

call move( . * p in 1 , r f cbaddr+9 , 3) ; 
rf cb( 32) = G; 

if openGf i le( r febaddr ) = 255 then 
do ; 

call pr int( . ’ no intermediate file found S’); 
go to boot; 
end ; 

end openCp inOf i le ; 



rewindCp inOf i le ; proc ; cp/m does not retire any action %/ 

return; prior to reopening %/ 

end rewindOp inOf i le ; 



readCp inOf i le • proc byte; 
dc 1 dent byte ; 

if ( dent : =read0f i le( r febaddr) ) > fileeof then 

call d iskerr ; 
return dent; 
end readOp inOf i le ; 



ge t One xt Gbyte • proc byte; 
del addeof data('l’); 
next Op inOchar : proc byte; 

return p inbuf f ( p inptr ) ; 
end nextOpinSchar ; 

checkfile: proc byte; 

do forever; 

if (pinptr := pinptr + 1) >= curp inrecs ize then 

do ; 

pinptr s 0; 

if readOp inOf i le = fileeof then 
return true; 

end ; 

nestchar = nextOp inOchar ; 
re turn false; 
end ; 
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end checkf i le ; 



if checkf i le or (nestchar = eoffiller) then 
do ; 

call mo ve ( . addeo f , sbloc, 1); 
pinptr = 0; 

nentchar = next Cp inCchar ; 
end ; 

return nestchar; 
end ge tSnextObyte ; 



ge tOnextGaddr • proc addr; 

del ( Iowa , higha , tadd ) addr; 
Iowa = doub le ( ge tGnextObyte ) ; 
higha = doub le ( ge tGnextObyte ) ; 
tadd = shl ( higha , S) ; 
tadd = tadd + Iowa; 
return tadd; 
end ge tCnextCaddr ; 



/#%%#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 
/XXX general procedures XXX/ 
/'XxmzXiXXXXXXXXXXXXXXXXXXXXXXXi 

/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 

/X popGsvOaddr removes the first two bytes */ 
/X from the stack and saves them in the X/ 
/X address indicated as a parameter. X/ 
/X total number of bytes generated = 7 X/ 
/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 
popOs vGaddr * proc(a) ; 



dc 


1 a addr; 








ca 


11 


genera 


t e ( 2 Ih) ; 


/* 


Ixi */ 


ca 


1 1 


genera 


te( low(a) ) ; 


/* 


storage place 


ca 


1 1 


genera 


t e ( high< a ) ) ; 






ca 


11 


genera 


te ( 0c Ih) ; 


/* 


pop b */ 


ca 


1 1 


genera 


t e ( 7 lh) ; 


/* 


mo vra c X/ 


ca 


11 


genera 


te ( 23h) ; 


/* 


inx h X/ 


ca 


1 1 


genera 


te ( 70h) ; 


/* 


mo vra b X/ 



end popOsvSaddr; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 
/X pushGsvOaddr returns the address from X/ 
/X the specified address to the stack. 

/X total number of bytes generated = 7 X/ 



pushOs vGaddr * proc(a); 
dc 1 a addr ; 
call genera te ( 2 Ih) ; 
call generate( low(a) ) ; 
call generate(hi gh( a) ) ; 
call genera te ( 4eh) ; 
call genera te ( 23h) ; 
call genera te ( 46h) ; 
call genera te( 0c5h) ; 
end pus hOs vGaddr ; 



/X 


Ixi */ 




/X 


re tr ie^ 


ying addr X/ 


/X 


move m 


X/ 


/X 


inx h X/ 


/X 


mo vb m 


X/ 


/X 


push b 


X/ 



/X popCint removes the first two bytes */ 

/X from the stack and saves them in the X/ 

/* address indicated as a parameter. X/ 

/X total number of bytes generated =7 X/ 

/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/ 
popOint? proc(a); 
del a addr ; 
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ca 


1 


1 


ge 


ne 


r a 


te 


< 2 lh) ; 


/* 


lxi 


h */ 


ca 


1 


1 


rv a 
D v 


ne 


ra 


te 


( lowCa) ) ; 


/* 


addr 


of i: 


ca 


1 


1 


S* 


ne 


ra 


t e 


( high( a) ) ; 








ca 


1 


1 


0*0 
c ? w 


ne 


ra 


t e 


<0c lh) ; 


/* 


pop 


b */ 


ca 


1 


1 


S*e 


ne 


ra 


te 


<71h) ; 


/* 


mo vra 


c */ 


ca 


1 


1 


ge 


ne 


ra 


te 


( 23h) ; 


/* 


inx 


h */ 


ca 


i 


1 




ne 


2’ a 


te 


( 70h) ; 


/X 


mo vm 


. b */ 



end popO int ; 



/%XXX% :%X#XXXXXXXXXXXXXXX 
/X p us li3 int returns 

/'!' the specified address 
/* total number of bytes 



iXXXXXXXXXXXXXXXXXXXS 

the integer from */ 
to the stack. */ 
generated = 7 */ 






pushOint: proc(a); 



dc 


1 < 


a addr; 










ca 


1 1 


genera 


t e ( 2 lh) ; 


/* 


1 x i h 


*/ 


ca 


11 


genera 


t e < 1 o w( a ) ) ; 


/* 


addr o 


f i: 


ca 


11 


genera 


t e ( high( a ) ) ; 








ca 


11 


gene ra 


te ( 4eh) ; 


/* 


move ra 


*/ 


ca 


11 


genera 


te ( 23h) ; 


/* 


inx h 


*/ 


ca 


11 


genera 


t e ( 46h) ; 


/* 


mo vb ra 


*/ 


ca 


11 


genera 


i e ( Oc5h) ; 


/* 


push b 


*/ 



end pushOint; 



/'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXS 
/* popObcd removes the last S bytes from the */ 
/* stack and places them in the working area 
/* starting at address a which is passed as */ 
/* a parameter by the user. */ 

/* total number of bytes generated = 23 */ 

popObcd: proc(a); 



del i byte, a addr; 


call genera te ( 2 lh) ; 


/* 


lxi h */ 


call genera te ( low( a) ) ; 




/X addr of bed 


call genera te( high( a) ) ; 
do i= 1 to 4 ; 


call genera te ( 3c lh) ; 


/* 


pop b */ 


call genera te ( 7 lh) ; 


/* 


raovm c */ 


call genera te( 23h) ; 


/* 


inx h X/ 


call genera te ( 79h) ; 


/* 


movm b */ 


call genera te( 23h) ; 


/* 


inx h X/ 


end ; 



end popObcd ; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 

/X pushObcd places the 8 bytes of a bed nunr- */ 
/* ber , whose last array address a Is passed */ 
/* as a parameter by the user, into the stack*/ 
/* total number of bytes generated 3 23 X/ 

/Jj:^^>f{5f{5K*5}C***********>fC^***^*«*****5fC^*********/ 

pushObcd: proc(a); 



del i byte, a addr; 


call genera te ( 2 lh) ; 


/* 


lxi h */ 


call genera te ( low( a) ) ; 


/% 


addr of bed */ 


call genera te ( high( a) ) ; 
do i= 1 to 4 ; 


call genera te ( 46h) ; 


/X 


movb m */ 


call genera te ( 2bh) ; 


/X 


d c x h X/ 


call genera t e( 4eh) ; 


/X 


mo vc m X/ 


call genera te ( 2bh) ; 


/X 


dex h X/ 


call genera te ( 0c 5h) ; 


/ X 


push b X/ 



end ; 

end pushObcd; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 

/* coraplObcd complements a bed number located X/ 
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/* at the working area in location of z, the */ 
/* address a passed as a parame ter is the ad- */ 
/* dress of the first byte of the number array*/ 
/* total number of bytes generated = 43 */ 

complObcd: proc(a); 



del i byte, a addr; 






call genera te ( 2 lh) ; 


/* 


1 x i h */ 


call ge ne r a t e ( 1 o w( a ) ) ; 


/* 


addr of bed %/ 


call genera te ( high( a) ) ; 






call generaie( 3ah) ; 


/* 


Id i */ 


call genera te ( COh) ; 


/* 


10000000 */ 


call genera te ( S6h) ; 


/* 


add m */ 


call genera t e ( 77h) ; 


/* 


mo vm a */ 


call genera te ( 23k) ; 


/* 


i ns h */ 


do i= 1 to 7 ; 






call genera te ( 3ak) ; 


/* 


Ida */ 


call genera te( 99h> ; 


/* 


99 */ 


call genera te ( 9bh) ; 


/* 


s ub m */ 


call genera te ( 77h) ; 


/* 


mo vm a */ 


call genera te ( 23h) ; 


/* 


ins h */ 



end ; 

end complSbcd; 



/* mult Sint pops two integer numbers from the */ 

/* stack and mill tip lies them together . then */ 

/* pushes the resulting integer back in the stack */ 
/* total number of bytes generated = 40 */ 



Si 


nt 


proc( 


a) ; 












dc 


1 a addr; 














ca 


11 


genera 


te(0dlh) ; 




/* 


pop 


d 


*/ 


ca 


11 


genera 


te ( 0c lh) ; 




/* 


pop 


b 


*/ 


ca 


l 1 


genera 


te ( 0c3h) ; 




/* 


J m p 


*/ 




ca 


1 1 


genera 


t e ( lo w( a + 


24h) ) 


? 








ca 


1 1 


ge nera 


te ( high( a 


+ 24h) 


) ; 








ca 


11 


genera 


te ( 79h) ; 




/* 


rao va 


c 


*/ 


ca 


1 1 


genera 


t e ( 93h) ; 




/* 


sub 


e 


*/ 


ca 


11 


genera 


te(7Sh) ; 




/*mo va 


b 


*/ 


ca 


1 1 


genera 


t e ( 9ah) ; 




/* 


sbb 


d 


*/ 


ca 


11 


genera 


t e ( Of 2h) ; 




/* 


jp */ 




ca 


1 1 


genera 


t e ( 1 o w( a + 


llh) ) 


? 








ca 


1 1 


ge nera 


te ( high( a 


+ llh) 


) ; 








ca 


11 


genera 


te ( 60h) ; 




/* 


mo vh 


. b 


*/ 


ca 


11 


ge ne r a 


ie(69h) ; 




/* 


mo vl 


c 


*/ 


ca 


1 1 


genera 


t e ( Oebh) ; 




/* 


xc hg 


*/ 


ca 


1 1 


genera 


te(44h) ; 




/* 


mo vb 


h 


*/ 


ca 


11 


genera 


te ( 4dh) ; 




/* 


mo vc 


1 


*/ 


ca 


11 


genera 


te ( 2 lh) ; 




/* 


lxi 


h 


*/ 


ca 


11 


genera 


te ( OQk) ; 












ca 


1 1 


genera 


te(00h) ; 












ca 


11 


genera 


t e ( Oebh) ; 




/* 


xc hg 


*/ 


ca 


11 


genera 


te(7Sh) ; 




/* 


rao va 


b 


*/ 


ca 


11 


genera 


te(0blh) ; 




/* 


ora 


c 


*/ 


ca 


11 


genera 


t e ( 0c8h) ; 




/* 


rz */ 




ca 


1 1 


genera 


t e ( Oebh) ; 




/* 


xchg 


*/ 


ca 


1 1 


genera 


t e ( 78h) ; 




/* 


mo va 


b 


*/ 


ca 


11 


genera 


te( Ifh) ; 




/* 


rar 


*/ 




ca 


11 


genera 


te(47h) ; 




/* 


mo vb 


a 


*/ 


ca 


11 


genera 


te ( 79h) ; 




/* 


rao va 


c 


*/ 


ca 


11 


genera 


te ( 1 f h) ; 




/* 


rar 


*/ 




ca 


11 


genera 


te ( 4f h) ; 




/* 


rao vc 


a 


*/ 


ca 


1 1 


genera 


te(0c2h) ; 




/* 


jnc 


*/ 




ca 


1 1 


genera 


t e ( 19h) ; 




/* 


dad 


d 


*/ 


ca 


11 


genera 


t e ( Oebh) ; 




/* 


xchg 


*/ 


ca 


11 


genera 


te(29h) ; 




/* 


dad 


h 


*/ 


ca 


11 


genera 


te ( 0c3h) ; 




/* 


Jmp 


*/ 




ca 


1 1 


genera 


te ( 0f Sh) ; 




/* 


call 


*/ 


ca 


1 1 


genera 


t e ( 1 o w( a + 


5) ) ; 










ca 


1 1 


genera 


te ( high( a 


+ 5) ) ; 
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push d %/ 



call genera te ( Qd5h) ; 
e nd rau 1 i 0 i n t ; 



/X divCint pops two integer numbers from #/ 

/# the 3 tack, divides the second number */ 

/* removed by the first number removed */ 

/%' and returns the result to the stack */ 

/* total number of bytes generated = 54 

divOint: procCa); 
dc 1 a addr ; 

call gtenC Gdlh,Oclh, Gc3h, low( a +50) , high( a+50) , 7ah, 2f h, 57h, 7b h, 2f h) 
call glen( 5f h, 13h, 2 Ih, OGh, ©Oh, 3eh, llh,0e5h, 19h,Cd2h) ; 
call genera te C* lowC a + 23) ) ; 
call gsneratet high(a + 23)); 

call gtenC0e3h,Gelh,Gf5h,79h, 17h,4fh,78h, 17h,47h,?dh) ; 
call gtenC I7h, <3f h, 7c h, 17h, 57h, Of lh, 3dh, Qc2h, lowC o + 17) , high( a+ 17) ) ; 
call gtenC Gb7h, 7c h, 1 fli, 57h, 7dh, lfh,5fii,©c9h,Gcdh, low( a+5) ) ; 
call generateC high(a + 5)); 
call genera te ( Gc5h) ; 
end d i vG int ; 






1 tO int compares the next two 


integers in 


%/ 


the s 


tack and returns 


a 1 to 


the stack 


*/ 


if the comparison is 


true or 


a 0 if the 


*/ 


/* comparison is false. 






%/ 


/* total 


number of bytes 


generated = 23 


%/ 


/ # * * * # * $Z * # 5fC * JjC JfJ 5?C * $ % * # * % # & * * JjC * # # JfC * * * # 55- * * $ 5ft % & J, 5 




1 tO int i 


proc ( a) ; 








dc 1 ; 


a addr ; 








call 


genera te C Od lh) ; 


/* 


pop d 




call 


generateCQc lh) ; 


/* 


pop b 




call 


genera te ( 79h) ; 


/* 


mo va c 




call 


genera te (93h) ; 


/* 


sub e X/ 




call 


genera te C 4fh) ; 


/* 


move a 




call 


genera te ( 7Sh) ; 


/* 


mo va b 




call 


generateC 9ah) ; 


/* 


sbb d afe/ 




ca 1 1 


genera te ( 0d2h) ; 


/* 


jnc 




call 


generateC lowCa 


+ IS) ) ; 






call 


generateC highC a 


+ 18) ) ; 






call 


genera te C Oeh) ; 


/* 


mv 1 c */ 




call 


generateC 0 lh) ; 








call 


genera te C G6h) ; 


/* 


mvi b */ 




call 


genera te C OGh) ; 








call 


genera te C Gc5h) ; 


/'•& 


push b */ 




call 


genera te C Gc3h) ; 


/% 


jrap ajc/ 




call 


generateC lowCa 


+ 23) ) ; 






call 


generateC highC a 


+ 23) ) ; 






call 


genera te C Oeh) ; 


/* 


ravi c 




call 


generateC GOh) ; 








call 


genera te C 06h) ; 


/* 


mv i b */ 




call 


genera te C 00h) ; 








call 


genera te C 0c5h) ; 


/* 


push b %/ 




e nd 1 1 0 1 


at ; 












/* leOint compares the next two integers in #/ 

/«' the stack and returns a 1 to the stack #/ 

if the comparison is true or a 0 if the 
/# comparison is false. */ 

/* total number of bytes generated = 23 






leO int • proc ( a) ; 



del ; 


a addr; 








call 


genera te C 0c lh) ; 


/* 


pop b 


*/ 


call 


genera te C Od lh) ; 


/* 


pop d 


*/ 


call 


generateC 79h) ; 


/% 


mo va c 


X/ 
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end 



ca 1 
cal 
cal 
cal 
cal 
cal 
cal 
ca 1 
cal 
cal 
cal 
cal 
cal 
cal 
cal 
ca 1 
ca 1 
cal 
cal 
cal 
leO 



1 ge 
1 ge 
1 ge 
1 ge 
1 ge 

1 ge 

l ere 

l 

1 ge 
1 ge 
1 ge 
i 



ge 



A 
11 

• 1 S 
1 1 ge 
1 ge 
ge 

ge 

ge 



nera te ( 
nera te ( 
nera te ( 
ne r a t e ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera te ( 
nera t e ( 
nera t e ( 
ner3 t e ( 



93h) ; /X sub e X/ 

4 fh) ; /X move a X/ 

7Sh) ; /X mo va b X/ 

9ah) ; /X sbb d X/ 

Odah) ; /* jc */ 

low(a + 18) ) ; 
high( a + IS) ) ; 



3 eh) 

01h) 

06h) 

GQh) 

0c5h) 

GcGh) 



/J'J w»y ? 






/X mvi b 






push b */ 
jmp */ 



low( a + 23) ) ; 
high( a + 23) ) ; 

Oeh) ; /X ravi c X/ 

OGh) ; 

06 h) ; mvi b 

OOh) ; 

0c51i) ; /X push b X/ 



int ; 






/# gtOint compares the nezt two integers in 
/X the stack and returns a 1 to the stack X/ 

if the comparison is true or a 0 if the X/ 

/X comparison is false. X/ 

/X total number of bytes generated = 23 X/ 



/^^^HiXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXy 



gtO int • proc ( a) ; 
dc 1 a addr; 



call 


genera te ( 0c lh) ; 


/* 


pop 


b */ 


call 


genera te ( Od lh) ; 


/* 


pop 


d */ 


call 


genera te ( 79h) ; 


/X 


mo va 


c X/ 


call 


genera te ( 93h) ; 


/* 


sub 


e X/ 


call 


genera te ( 4fh) ; 


/X 


move 


a */ 


call 


genera te ( 78h) ; 


/* 


mo va 


b */ 


call 


genera te ( 9ah) ; 


/X 


sbb 


d */ 


call 


genera te ( 0d2h) ; 


/X 


Jnc 


x/ 


call 


genera te ( low( a + 


18) ) ; 






call 


genera te ( high( a + 


18) ) ; 






call 


genera te ( Qeh) ; 


/X 


mvi 


c */ 


call 


genera te ( 0 lh) ; 








call 


genera te ( 06h) ; 


/* 


ravi 


b X/ 


call 


genera te ( O0h) ; 








call 


genera te ( Gc 5h) ; 


/X 


push 


l b */ 


call 


genera te ( Gc3h) ; 


/X 


J ra P 


X/ 


call 


genera te ( low( a + 


23) ) ; 






call 


genera te ( high( a + 


23) ) ; 


i 




call 


genera te( Oeh) ; 


/* 


mvi 


c 


call 


genera te ( GGh) ; 








call 


genera te ( 06h) ; 




mvi 


b x/ 


call 


genera te( GQh) ; 








call 


genera te ( 0c5h) ; 


/* 


push 


l b X/ 



end gtGint; 



/ X X 5#C * # # * * # * * * # * X J*C * 5fc X X X ife # 5fcsfc * ** * * 5fc 5#c * X * ## *5jC # JjC* X / 



/'i* geO int compares the next two integers In */ 
/X the stack and returns a 1 to the stack X/ 
/X if the comparison is true or a 0 if the X/ 
/X comparison is false. 

/X total number of bytes generated = 23 X/ 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 



geGinti proc(a) 



dc 1 


a addr; 










call 


genera te ( Gd lh) ; 


/X 


pop 


d 


X/ 


call 


genera te ( Gc lh) ; 


/X 


pop 


b 


X / 


call 


genera te( 79h) ; 


/X 


rao va 


c 


X/ 


ca 1 1 


genera te ( 93h) ; 


/X 


sub 


e 


X/ 


call 


genera te ( 4fh) ; 


/X 


mo vc 


a 


X/ 
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ca 


11 


genera 


te(7Sh) ; 


/X 


mo va b 


*/ 


ca 


1 1 


genera 


lei 9ah) ; 


/X 


sbb 


d 


*/ 


ca 


11 


genera 


te ( Gdah) ; 


/X 


jc 


*/ 




ca 


11 


ge nera 


t e ( 1 o w( a + 


18)) ; 








ca 


1 1 


genera 


te(high(a + 


18) ) ; 


) 






ca 


11 


genera 


te ( Oeh) ; 


/* 


mvi 


c 


X/ 


ca 


11 


genera 


te ( 0 lh) ; 










c a 


11 


genera 


te ( 05h) ; 


/% 


mvi 


b 


X/ 


ca 


11 


genera 


te ( ©Oh) ; 










ca 


11 


genera 


te ( Qcoh) ; 


/X 


push b 


X/ 


ca 


1 1 


genera 


te( Gc3h) ; 


/X 


jmp 


%/ 




ca 


11 


genera 


t e ( 1 o w( a + 


23) ) ; 








ca 


11 


genera 


t e ( high( a + 


23) ) j 








ca 


11 


genera 


te ( 0eh) ; 


/% 


mvi 


c 


X/ 


ca 


11 


genera 


te(QQh) ; 










ca 


11 


genera 


t e ( Gbh) ; 


/X 


mvi 


b 


X/ 


ca 


11 


genera 


t e ( GOh) ; 










ca 


11 


genera 


te ( 0c5h) ; 


/X 


push b 


X/ 



end geO int ; 






/X eqOint compares the next two Integers in X/ 
/X the stack and returns a 1 to the stack X/ 
/X if the comparison is true or a 0 if the X/ 
/X comparison is false. X/ 
/X total number of bytes generated = 24 */ 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXS 

eqOinti proc(a); 



del i 


a addr; 








ca 1 1 


genera te ( Od lh) ; 


/% 


pop 


d */ 


call 


genera te ( Gc lh) ; 


/X 


pop 


b 


call 


genera te ( 79h) ; 


/* 


rao va 


c X/ 


call 


genera te ( 93h) ; 




sub 


e */ 


call 


genera te( 4fh) ; 


/* 


move 


a */ 


call 


genera te ( 78h) ? 


/% 


mo va 


b */ 


call 


genera te ( 9ah) ; 


/X 


sbb 


d 


call 


genera te ( Gb lh) ; 


/X 


ora 


c X/ 


call 


genera te ( 0c2h) ; 




jnz 


X/ 


call 


genera te( low(a 


+ 19)); 






call 


genera te ( high( a 


+ 19)); 






call 


ge ne r a t e ( Oe h) ; 


/* 


mvi 


c */ 


call 


genera te ( 0 lh) ; 








call 


genera te ( G6h) ; 


/X 


mvi 


b */ 


call 


genera te ( GOh) ; 








call 


genera te ( 0c5h) ; 


/X 


push 


l b X/ 


call 


genera te ( Oc 3h) ; 


/X 


Jmp 


X/ 


call 


genera te ( lo w( a 


+ 24)) ; 






call 


genera te ( high( a 


+ 24) ) ; 






ca 1 1 


genera te ( Geh) ; 


/% 


mvi 


c X/ 


call 


genera te ( GOh) ; 








call 


genera te ( G6h) ; 


/X 


mvi 


b X/ 


call 


genera te ( GOh) ; 








call 


genera te ( 0c5h) ; 


/X 


push 


l b X/ 


end e qS int; 












/X 


neOint compares the next 


two 


integers in 


X/ 


/X 


the stack and returns a 1 


to 


the stack 


X/ 


/X 


if the comparison is true 


o r 


a G if the 


X/ 


/X 


comparison is false. 






X/ 


/X 


total number of bytes generated = 24 


X / 


/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXS 


neOint: proc(a); 










del a addr ; 

call genera te ( Gd lh) ; 


/X 


pop d X/ 






call genera te ( Gc lh) ; 


/X 


pop b X/ 






call gene ra t e ( 79h) ; 


/X 


mo va c X/ 






call genera te ( 93h) ; 


/X 


sub e X/ 






call ge ne r a t e ( 4 1 h) ; 


/X 


move a X/ 






call genera te ( 78h) ; 


/X 


mo va b X/ 
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call 


genera te ( 9ah) ; 


/* 


sbb 


d */ 


call 


gener a te ( Ob lh) ; 


/* 


ora 


c */ 


call 


genera te ( 0c2h) ; 


/* 


jnz 


%/ 


call 


ge nera te ( lo w( a + 


19) ) ; 






call 


genera te ( high( a + 


19) ) 


? 




call 


genera te ( Qeh) ; 


/* 


mvi 


c */ 


call 


genera te ( 0 lh) ; 








call 


genera te ( 06h) ; 


/% 


mvi 


b */ 


call 


genera te ( GOh) ; 








call 


genera te ( Gc5h) ; 


/* 


push b */ 


call 


genera te ( 0c3h) ; 


/* 


jmp 


*/ 


call 


genera te ( low( a + 


24) ) ; 






call 


genera te ( high( a + 


24) ) 






call 


genera te ( Qeh.) ; 


/* 


mvi 


c */ 


call 


genera te ( 00k) ; 








call 


genera te ( 06h) ; 


/* 


mvi 


b */ 


call 


genera te ( OOh) ; 








call 


genera te ( Ocoh) ; 


/* 


push b */ 



end neO int ; 



/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX*#/ 

/* notObool negates a *0’ to a *1* and a */ 
/* *1* to a ’0* taking the last byte of the */ 
/* stack and returning its complement to the*/ 
/* stack, total number of bytes = 19 */ 



no t Oboo 1 


: proc ( a ) ; 








dc 1 ; 


a addr; 








call 


genera te ( Qc lh) ; 


/* 


pop 


b */ 


call 


genera te ( 79h) ; 


/* 


mova c */ 


call 


genera te ( Of h) ; 


/* 


rrc 


*/ 


call 


genera te ( 0d2h) ; 


/* 


jnc 


*/ 


call 


genera te ( low( a + 


14) ) ; 






call 


genera te ( high( a + 


14) ) \ 






call 


generate(Oeh) ; 


/% 


mvi 


c */ 


call 


genera te ( GOh) ; 








call 


genera te ( 06h) ; 


/% 


mvi 


b */ 


call 


genera te ( OOh) ; 








call 


genera te ( 0c5h) ; 


/* 


push b */ 


call 


genera te ( 0c3h) ; 


/* 


jmp 


*/ 


call 


genera te( low< a + 


19) ) ; 






call 


genera te( high( a + 


19) ) ; 






call 


genera te ( Oeh) ; 


/* 


mvi 


c */ 


call 


genera te ( OOh) ; 








call 


genera te ( 06h) ; 


/* 


mvi 


b */ 


call 


genera te ( OOh) ; 








call 


genera te ( 0c 5h) ; 


/* 


push b */ 


end no tOboo 1 ; 









/^^c^cHc***************************************/ 

/* andCboo 1 pops the last two integers from */ 
/* the stack calculates their logical ’and 1 */ 
/* and returns the new value to the stack. */ 
/* total number of bytes generated = 26 */ 

/ * # * JfC 5fC % * 5fC % 5fC * % JfC * $ ** JfC * % * * * * # * * * * * * * * 5jC3rC * % * :fc * * # * * / 



andOboo 1 '• 


proc( 


a) ; 










dc 1 a addr ; 












call 


genera 


te ( Od lh) ; 


/* 


pop 


d 


*/ 


call 


genera 


te ( 0c lh) ; 


/* 


pop 


b 


*/ 


call 


genera 


te ( 79h) ; 


/* 


mova 


c 


*/ 


call 


genera 


te ( 0a3h) ; 


/* ana 


e 


*/ 


call 


genera 


te(4fh) ; 


/* 


mo vc 


a 


*/ 


call 


genera 


te(7Sh) ; 


/* 


mo va 


b 


*/ 


call 


genera 


te(Oalh) ; 


/* 


ana 


c 


*/ 


call 


genera 


te ( 47h) ; 


/* 


mo vb 


a 


*/ 


call 


genera 


te ( 79h) ; 


/* 


mova 


c 


*/ 


call 


genera 


te ( Of h) ; 


/* 


rrc 


*/ 




call 


genera 


te ( 0d2h) ; 


/* 


jnc 


*/ 




call 


genera 


te ( lo w( a 


+ 21) ) ; 








call 


genera 


t e ( high( a 


+ 21) ) ; 
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/X mv i c 



call generateCGeh) ; 
call genera te ( G lb.) ; 
call genera te C G6h) ; /X mvi b 

call generate(GOh) ; 

call genera te ( 0c5h) ; /X push b X/ 

call genera te C Gc3h) ; /X Jmp X/ 

call genera te ( low( a + 26)); 
call ge ne rate(liigh(a + 26)); 
call genera te( Qeh) ; /X mvi c X/ 

call genera te ( ©Oh) ; 

call genera te ( 06h) ; /X mvi b X/ 

call genera te ( OOh.) ; 

call genera te ( Gc 5 h) ; /X push b X/ 

end andCboo 1 ; 



/ % * # * % x< # # % # * * * * jf: * * % * * ^ * * jfc £ ; • c # :fc & X * * X ^ * # / 

/•.' orCbool pops the last two integers from */ 
the stack calculates their logical ’or’ */ 
/X and returns the new value to the stack. X/ 
/X total number of bytes generated = 26 
/ # ^ 5fc * # :jc # # X sfc :ji * « * ijc :K * 5fc * % X X X X X X * X ^ * * X # # # jfc X X * £ * / 
orOboo 1 s procCa); 



del ; 


a addr; 








call 


genera te ( Od lh) ; 


/* 


pop 


d X/ 


call 


genera te ( Gc lb) ; 


/* 


pop 


b X/ 


call 


genera te ( 79h) ; 


/X 


mo va 


c X / 


call 


genera ie ( Gb3h) ; 


/X ora 


e X/ 


call 


genera te C 4?h) ; 


/X 


mo vc 


a */ 


call 


genera te ( 7Sh) ; 


/X 


mo va 


b X/ 


call 


genera te ( Gb2h) ; 


/X 


ora 


d X/ 


call 


genera te ( 47h) ; 


/X 


mo vb 


a */ 


call 


genera te ( 79 h) ; 


/X 


mo va 


c X/ 


call 


genera te ( Of h) ; 


/X 


rrc 


X/ 


call 


genera te ( 0d2h) ; 


/X 


jnc 


X/ 


call 


genera te ( low( a + 


21) ) ; 






call 


genera te ( hi ghC a 


+ 21)); 






call 


genera te ( Qeh) ; 


/X 


mvi 


c X/ 


call 


genera te ( 0 lh) ; 








call 


genera te ( G6h) ; 


/X 


mvi 


b x/ 


call 


genera te ( GGh) ; 








call 


genera te ( Qc5h) ; 


/ X 


push b */ 


call 


genera te ( 0c3h) ; 


/X 


Jmp 


xs 


call 


genera te ( lowC a + 


26) ) ; 






call 


genera te ( hi gh( a 


+ 26) ) ; 






call 


genera te ( Geh) ; 


/X 


mvi 


C X/ 


call 


genera te ( ©Oh) ; 








call 


genera te C G6h) ; 


/X 


mvi 


b X/ 


call 


genera te ( OGh) ; 








call 


genera te ( Gc5h) ; 


/X 


pus h 


l b X/ 



end orGboo 1 ; 



/ «b \U \b \b vb \b vb vp vb \b ^b %b vb vb ^ ^ sb «b «b ^ vb \b vb *b ^\b \b vb sb vb<> / 

/ /b - T % 'f' -f* "T* 'b A' 'b ^b 'b ^b 'b ^b <b f b ^b 'b ^b <b 'b 'b ^b *b <b d' # b^b ^b ^b 'b 'b 'b'b / 

/* svGstack increses the size of the stack X/ 
/X by moving the stack pointer (b) times X/ 
/X total number of bytes generated = b X/ 

/ X X X X X ijc :#c * * # >#: if: X X * * :£ x # # * afc ;fc x x X * X * # # * & * * * * X * * * X / 
svGstack: proc(b); 
del ( i , b) byte ; 
do i= 1 to b ; 

call genera te ( 3bh) ; /* dex sp */ 

end ; 

end svGstack; 



/ * # # 5#C * * * * # X X X X # X # * * * X * * * * X * * * * ; ^ jfc # ;t; ^C5(C ^ ^ JfC / 

/* unsvSs tack decreases size of the stack %/ 
/* by moving the stack pointer (b) times sfc/ 
total number of bytes generated - b X/ 

unsvGstack: proc(b); 
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/* ins sp */ 



del ( i , b) byte ; 
do i = 1 to b ; 
call genera te ( 33h) ; 
end ; 

end unsvOstack; 



/* stoObcd stores eight bytes from the */ 

/* stack into an address calculated from */ 

/* the first two bytes taken from the stack */ 
total number of bytes generated = 21 */ 





* * X * ::: * ****** % 




^ sit jjc iji >’c ;{c ; 


s t oGbcd : 


proc ; 






del 


i byte; 






call 


genera te ( Ge lh) ; 


/* 


pop h */ 


do i 


= 1 to 4 ; 






call 


generate(0c lh) ; 


/* 


pop b */ 


call 


genera te ( 7 lh) ; 


/* 


mo vm c */ 


call 


genera te( 23h) ; 


/* 


inx h */ 


call 


genera te ( 70h) ; 


/* 


movm b */ 


call 


genera te ( 23h) ; 


/* 


inx h */ 



end ; 

end stoObcd; 



/ 5fC # * JfC* 5fC?fC Jfc SfC * JjOj? * JfC * * * Jj? * JfC JfC ** 5jC 5jC * JjCJfCifc * JjCJrC # * * * $ ;fc * / 

/* lodGbcd removes the first two bytes from*/ 

/* the stack , calculates the address of */ 

/* the bed number and moves 8 bytes into */ 

/* the stack, total bytes generated = 21 */ 

/*******************************************/ 
lodGbcd : pr oc ; 

del i byte ; 



gene 


ra te ( Oe lh) ; 


/* 


pop 


h 


*/ 


= 1 to 


, 4; 












call 


genera 


te ( 46h) ; 


/* 


mo vbra 


*/ 


call 


genera 


te ( 2bh) ; 


/* 


dex 


h 


*/ 


call 


genera 


te ( 4eh) ; 


/% 


mo vc 


m 


t */ 


call 


genera 


te(2bh) ; 


/* 


dex 


h 


*/ 


call 


genera 


te ( 0c5h) ; 


/* 


push b 


*/ 



end ; 

end lodGbcd; 



/^**:fc**5£;:<**>j:>f:***:S#:f:;fc:&************************/ 

/* printSint prints to the console the */ 

/# integer specified by the calling routine */ 

/* total bytes generated = 570 */ 

printGint: proc(a); 

dc 1 a addr ; 

call genGf i ve ( 0c3h, low( a+3dh) , high( a+3dh) , 2 lh, Of h) ; 
call genGf i ve( 0 lh, 7 lh, 2ch, 73h, 23h) ; 

call g ten( 72h, 0c3h, G5h, O0h, 0c9h, 2 lh, 12h, 0 lh, 7 lh, 0eh) ; 
call gten( 02h, 5eh, 16h, 00h, 0 c dh, low( a+3h) , high( a+3h) ,21h,3fh,01h) ; 
call gten( 34h, 3eh, 4f h, 96h, Gd2h, lov/( a + 3ch) , high( a+3ch) , Oeh, 02h, leh) ; 
call gten(0dh, 16h, OOh, 0c dh, low( a+03h) , high( a+03h> , Oeh, 02h, leh, 0a h) ; 
call gten( 15h, OOh, Ocdh, low(a+03h) , high( a+03h) , 2 lh, 3f h, 0 lh, 36h, OOh) ; 
call gten( 0c9h, 2 lh, Oeh, 01h, 36h, COh, 3eh, Of f h, 06h, 7f h) ; 
call gt en( 2ek, Oeeli, 96h, 2ch, 4f h, 781i, Oeh, 0d2h, low( a+66h) , high( a+66h) ) 
call gien( Oeh, 2dh, Ocdh, lov( a+0fh) , high( a+Gfh) ,0afh,21h, 08h, 01h, 96h) 
call gten( 2ch, 4f h, 3eh, 00h, 9eh, 2dh, 7 lh, 23h, 77h, 0c3h) ; 
call genGf i ve ( low( a+6bh) , high( a+6bh) , Oeh, 20h, Gcdh) ; 
call genGf ive( low(a+0fh) ,high(a+0fh) , 1 lh, 10h,27h) ; 
call gten( 2 lh, G8h, 0 lh, 4eh, 2ch, 46h, 0c3h, low(a+0a4h) , high( a+Ga4h) ,7ah) 
call gten(2fh, 57h, 7bh, 2f h, 5 f h, 13h, 2 lh, OOh, OOh, 3eh) ; 
call genSfive( 1 lh, 0e5h, 19h, 0d2h, lo w( a+89h) ) ; 
call genGf i ve ( high( a+89h) , 0e3h, 0elh,0f5h,79h) ; 
call gten( 17h,4fh,78h, 17h,47h,7dh, 17h,6fh,7ch, 17h) ; 
call gt en( 67h, Of lh, 3dh, 0c2h, low(a+83h) ,high(a+83h) ,0b7h,7ch, lfh,57h) 
call gten(7dh, 1 f h, 5f h, 0c9h, Ocdh, low( a+77h) ,kigh(a+77h) , Oa f h, 9 lh, 5 f h) 
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call gten( 3eh, 00k, 98h, 0d2k, low( a+ lOfh) , high(a+ 10 fh) , 2 lh, Qeh, 0 lh, 36h) 
call gten(01h,llh, 10h, 27h, 2 lh, 08h, 0 111, 4eh, 2ch, 46h) ; 

call gt en( Ocdh, low( a+77k) , higk( a+77h) , 2 lh. Oak, 9 lh, 7 lk. Ilk, 10h, 27h) ; 
call gten( 2 lh, Oak, 0 lh, 4eh, 06k, 00k, Oc3k, lo w( a+Gf 4h) , high( a+0f 4h) , 79 h) 
call gten( 93h, 73h, 9ah, Of 2k, lo w( a+0ddh) , highC a+Gddh) , 60k, 69h, Oebh, 44h) 
call g ien( 4dk, 2 lk, 00k, OOh, Oebh, 73k, Ob lk, OcDk, Oebk, 7Sh > ; 
call gtsnC If h, 47h, 7Ch, 1 f h, 4? k, 0d2h, lowCa+Oefk) , high( a+Qe f h) , 19h,Gebh) 
C 2 1 1 genOf ive ( , 0c3h, low( a+0e tk) , high( a+Oe lh) , Gcdh) ; 

call genGf i ve ( lo v( a+Od lh) , high( a+0d lh) , 2 lh, G8k, 0 lh) ; 
call gten(7ek,2ck,46k,93h,4fh,78k,9ak,2dh,71k,23k) ; 
call gien( 77k, 2ek, Odk, 7eh, 0c 5k, 30k, 77k, 4ek, Ocdh, low( a+0f h) ) ; 
call gten( high( a*!* Of h) ,11k, OeSh, 03k, 21k, 08k, G lk, 4eh, 2ch, Ocdh) ; 
call s len( Ccdli, lowC a+77Ii) , high( a+77k) , Oa f h, 9 lh, 5 f h, 3eh, GOk, 98h, 0d2h) 
call gten( low( a+ 160k) , high( a+ l6Gh) ,2Ih,Oek,01h, 36h, 0 lh. Ilk, Oe8h, 03k) 
call gten(21h, OSh, 0 lh, 4eh, 2ch, 46h, Gcdh, low( a+77h) , high( a+77h) , 2 lh) ; 
call gten(0dh,01h,71h, llh, 0e8h, 03k, 2lh,0dh,Glh, 04k) ; 
call gten( 06 h, 00k, Ocdk, low( a+Gd lh) , high( a+Od 111) ,21k, 08h, 0 lk, 7eh, 2ck) 
ca 1 1 3 ien( 46k, 93k, 4fk, 73k, 9ah, 2dh, 7 lh, 23k, 77h, 2eh) ; 
call gten(0dh,7eh, 0c6h, COh, 77h, 4eh, Ocdh, low( a+Of h) , higk( a+Gf h) , Gc3h> 
call genOf i ve ( low( a+ 16dk) , high( a+ 16dh) , 2 lk, Oeh, 0 lh) ; 
call genCf ive(7eh,0fk, 0d2h, lo w( a+ 16dh) , high( a+ 16dh) ) ; 
call gten( Oeh, 30h, Ocdk, low( a+Of h) , higk( a+Gf k) , leh, 64h, 16h, 00k, 21k); 
call gien( OSh, 0 lk, 4eh, 2ch, 46h, Gcdh, low(a+77h) , high(a+77h) , Gafh,91h) 
call gten(5fh,3eh, GOk, 9Sh, 0d2k, lo w(a+ lc lh) , high( a+lclk) , 2 lh, Oeh, 0 lh) 
call gt en( 36 li, 0 lh, lek,64h, 16k, OOh, 2 lh, OSh, 0 lh, 4ek) ; 

call gten( 2ch, 46k, Ocdk, low( a+77h) , high( a+77h) ,21h,Gdk,01k,7lh, lek) ; 

call gien(64h, 16k, GOk, 2 lk, Odk, Olh, 4eh, 06k, OOh, Ocdh) ; 

call glen( lo w( a+Od 111 ) , high( a+Od lh) , 21k, OSh, 0lh,7eh,2ch, 46 h, 93h, 4f k) 

call gten(78h,9ah,2dh,71h,23Ii,77h,2eh,0dh,7eh,0c6h> ; 

call genSf i ve ( 30h, 77h, 4eh, Ocdk, lo w( a+Of h) ) ; 

call genOf ive ( high( a+Gf h) , 0c3k, lowC a + lceh) , highC a+ lceh) , 2 lh) ; 
call gten(0ek,Qlh,7eh,0fh, 0d2k, low( a+ lceh) , highC a + leek) , Oeh, 30h, Ocdk) 
call gtenC low(a+0fh) ,high(a+Qfk) , lek, Oak, 16h, OOh, 21h, 08h, 6 lh, 4ek) ; 
call gtenC 2ch, 46 h, Gcdh, lowC a+77k) , highC a+77h) , Oa f k, 9 lh, 5f k, 3eh, 00k) 
call gtenC 9Sh, Gd2h, low( a+2 Idh) , highC a+2 Idh) , leh, Oak, 16h, 00k, 2 lh, 08k) 
call gie n( 0 lk, 4eh, 2ch, 46h, Gcdh, low(a+77h) ,high(a+77h) , 2lh, Odh, Olh) ; 
call gten(7lh,leh, Oak, 16k,00h,21h, Odh, 0 lk, 4eh, 06k) ; 
call gten( OOh, Ocdh, lowC a+Od lh) , highC a+0d lk) , 2 lh, OSh, Glk,7eh,2ch, 46h) 
call gtenC 93h,4fh,73h, 9ah, 2dh, 7 lk, 23k, 77k, 2ek, Odh) ; 
call gtenC 7eh, 0c6h, OOh, 77Ii, 4ek, Ocdk, low( a+Of k> , highC a+Of h) , 0c3k, 00k) 
call gtenC OOh, 2 lk, 0deh,Glh,7eh,0fh, 0d2k, lo w( a+22ah) , highC a+22ah> , Oeh) 
call gten( 30k, Ocdk, low(a+0fh) , highC a+Of h> , O lk, 30h, 00k, 2ak, 08h, 0 lh) ; 
call gtenC 09k, Oebk, 21k, 0a h, Olh, 73k, 4eh, Ocdk, lowC a+Gf h) , highC a + Of h) ) 
end printSint; 



/ * # * * * * 5jC * * Jfc * # * * JjC # ** * * ifc # * * * * X $Z>a # 5fc 5#: % * ^ 5fC * * * * X / 



/* printSbcd prints to the console a bed 
/# number moved to the working* area by the 
calling routine. 

/* total number of bytes generated = 4 64 */ 

/ * ^ ^ 5t; 5K « « « 5fc % # >fc 5fc * * * * :f: * * * * * # * * ^ X * * * * & / 



printCbcd: proc(a); 

dc 1 a addr ; 

call gten( 0c 3h, low( a+3dk) , high( a+3dh) , 2 lh, 13h, 01k,71h,2ch, 73k, 23h) ; 
call gten( 72h, 0c3h, 05k, 00k, 0c9h, 2 lk, I6h, 0 lh, 7 lh, Oeh) ? 
call gten( 02h, 5ek, 16k, 00h, Ocdk, low( a+3k) , high( a+3h) ,21h,3fh,Glh) ; 
call gtcn( 34h, 3eh,4fk,96k, 0d2k, lowC a+3ck) ,kigh( a+3ck) , 0ek, 02k, leh) ; 
call gten(0dh, 16h, OOh, Ocdh, low(a+3h) ,kigh(a+3k) ,0eh,02h, leh,0ah) ; 
call gten(16h, OOh, Ocdk, lo w( a + 3h) , higk( a+3k) ,2lh,3fh,01h,36h, COh) ; 
call gten(Oc9h,3ek,3ch,21h,3fh,01h,96k, 0d2k, lo w( a+5dk) , high( a+5dk) ) 
call gten( Oeh, 02h, leh, Odh, 16h, OOh, Ocdh, low( a+3h) , higk( a+3h> , Oeh) ; 
call g ten( 02h, lek, 0a h, 16 k, 00k, Ocdk, low( a+3h) , high( a+3h) , 2 lh, 3f k) ; 
call gten( Olh, 36h, OOh, 2eh, Of ah, 36 h, 07k, 3eh, 7f k, 2eh) ; 
call genOf ive ( G8h, 96h, 0d2h, low( a+78h) , high( a+78h) ) ; 
call genGf ive (Oeh, 2dh, Ocdk, low( a+Of k) , kigk( a+Gfk) ) ; 

call gten(21h, 08k, 01k, 7eh, Oe6k, 80k, 77k, 0c 3k, low( a+7dh) , kighC a+7dh) ) 
call gten(0eh, 20h, Ocdh, low( a+Of k) , higk( a+Ofk) , 2 lh, I2h, 0 lk, 4ek, 06 h) ; 
call gt en( 00k, 2eh, OSh, ©9h, 7eh, lek, 04k, 0b7h, lfh, ldk) ; 

call gtenC 0c2h, low( a+89h) , high( a+89h) , 0c6h, 30h, 2 lh, lOh, Olh, 77h, 4ek) 
call gtenCOcdk, lowC a+Ofk) ,kigh(a+Ofk) , Oeh, 2eh, Ocdk, 
lo w( a+Ofk) , high( a+Ofh) ,21k, Ilk) ; 
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call gten(Qlh, 36h, 9 lh, 3eh, OGh, 2 lh, 1 lh, 0 lh, 96 h, Odah) ; 
call gten( low( a+0e4h) , high( a+Ge4h) , 02c h, 4eh, 06h, OGh, 2eh, G8h, 09h, 7eh) 
call gten( OeGh, Of h, QcGh, 301i, 2 lh, lOh, Olh, 77h, 4eh, Gcdh) ; 
call s;ten( low< a+Ofh) ,high( a+Ofh) , 2lh, 12h, G 11a, 35h, 4eh, G6h, GGh, 2eh) ; 
call gten( 081a, 09h,7eh, leh, 04h, Gb7h, 1 fh, ldh, Gc2h, lo w( a+Gcdh) ) ; 
call gten( high( a+Ocdh) , 0c6h, 30h, 2lh, 10h, 0 lh, 77h, 4eh, Gcdh, low( a+GfhJ ) 
call gten( high( a+Ofh) , 2 lh, 1 lh, 0 lh, 34h, 0c2k, low( a+0a3h) , high( a+Ga3h) 
2eh,03h) ; 

call gten( 23h, 7eh, OeGh, Gf h, 0c6h, 30h, 21h, 10h, Olh, 77h) ; 
call g ten( 4eh, Ocdh, low(a+Gfh) ,high(a+0fh) ♦ Of h, 45h, Gcdh, 
low(a+Gfh) , high(a+Qfh) ,21h) ; 

call /;ten( C8h, 0 lh, 7eh, Odoh, 80h, 0d2h, low( a + 1 1 lh) , high( a+ 1 1 lh) , Geh, 2dh) 
call g ten( Gcdh, lo w( a + Of h) , higli( a+Qf h) , 3eh, 4 lh, 2 lh, G8h, 0 lh, 96h, 77h) ; 
call gten( 0c3h, low( a + 1 ldh) , high( a + 1 ldh) , Geh, 2Gh, 

Ocdh, low( a+Ofh) ,high(a+0fh) ,2lh,08h) ; 
call gten( 0 lh, 7eh, GdGh, 4 lh, 77h, leh,Gah, 16h,G0h,21h) ; 
call gten( 08h, 0 lh, 4eh, 06h, G0h, 0c3h, lo w( a+ 157h) , high( a + 157h) ,7ah,2fh) 
call gten( 57h, 7bh, 2f h, 3fh, 13h, 21h, OGh, 9Gh, 3eh, 1 lh) ; 
call gten( Oeoli, 19h , 0d2h, low( a+ loch) , high( a+ 13ch) , Ge3h, Ge lh, 
Ge5h,79h, I7h) ; 

call gten(4fh,7Sh, 17h,471i,7dh, 17h,6fh,7ch, 17h,67h) ; 

call gten(0flh,3dh, Gc2h, low( a+ I36h) , high( a+ 136h) , 0b7h, 7c h, 

1 f h, 57h, 7dh) ; 

call gten( 1 f h, 5 f h, 0c9h, Ocdh, low(a+12ah) , high( a+ I2ah) ,Gafh, 

9 lh, 5f h, 3eh) ; 

call ^ten( O0h, 93h, 0d21i, low(a+lbeh) , high( a + lbeh) , leh,Gah, 16h,GGh,21h) 
call gten( OSh, 0 lh, 4eh, OGh, GOh, Gcdh, low( a + 12ah) , 
high( a+ 12ah) , 2 lh, low( a+ 1 f 3h) ) ; 

call gten( high( a+ 1 f 3k) ,71h, leh, 0a h, 16h, OOh, 21h, lGh, G lh, 4eh) ; 
call gten( OGh, OOh, 0c3h, low( a+ la4h) , high( a+la4h) , 79h, 93h, 78h, 9ah, Gf2h) 
call gt en( low( a+ 13dh) , higk( a+ 1 8dh) , GOh, 69h, Oebh, 44h, 4dh, 2 lh, GGh, OGh) 
call gten(Gebh, 78k, Ob lh, Gc8h, Oebh, 73h, lfh,47h,79h, lfh) ; 
call gten(4fh, 0d21i, low( a + 19 f h) , high( a+ 19 f h) , 19h, Oebh, 29h, 

Gc3h, low<a+191h) , high( a+ 19 lh) ) ; 

call gten( Ocdh, low( a+ 18 lh) , high( a+ 181h) ,21h, G8h, Olh, 7eh, 93h, 4fh, 3eh) 
call gt en( OOh, 9ah, 7 lh, 2eh, lOh, 7eh, OcGh, 3Gh, 77h, 4eh) ; 
call gtenOcdk, low(a+Gfk) , hlgh( a+Qf h) ,0c3h, low(a+lc3h) , high( a+ lc3h) , 
Geh, 20h, Gcdh, low( a+Ofh) ) ; 

call gten( high( a+Ofh) , 2 lh, G8h, Glh,7eh,0c6h, 3Gh, 2eh, lGh, 77h) ; 
call genera te ( 4eh) ; 
call gene ra te ( Ocdh) ; 
call genera te ( low( a+Ofh) ) ; 
call genera te ( high( a+Ofh) ) ; 
end printObcd; 



/ * * # * * * * # * >fc ^ * * X * X * # * * :fc * :}: * * * * * * * X X ^ X X X X X X X X X & X X / 

/* neCbcd logically compares two bed numbers */ 

/* taken from the stack returns a value of one^/ 

/* if the numbers are not equal, a zero if */ 

/X equal, total number of bytes gen = 67 X/ 

/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 
neCbcd: proc(a); 
del a addr • 

call gten(21h, lah, 1 1 h, 3Gh, GGh, 2dh, 36h, GGh, 2 lh, 19h) ; 

call gten(llh,7eh, CdGh, OSh, Gd2h, lo w( a+3eh) , high( a+3eh) , 4eh, 06h, GGh) 
call gten(2eh, 0£h, 09h, 7eh, 21h, 19h, llh,5eh, I6h, GGh) ; 

call gten(2eh, lOh, 19h, 4f h, 7eh, 9 lh, Gcah, low(a+34h) ,high(a+34h) ,2lh) ? 
call gten(lah,llh, 36h, Olh, 2dh, 7eh, GcGh, G8h, 77h, Gc3h) ; 
call gten(low( a+3h) , high( a+8h) , 2 lh, 13h, 1 lh, 36 h, OGh, 2dh, 34h, 0c 3h) ; 
call genSf ive( low(a + 8h) ,high(a+8h) , 2ch, 4eh, G6h) ; 
call genera te ( GGh) ; 
call genera te ( Gcoh) ; 
end neCbcd; 



/ si* \I> <sJ> si# ^ ^ / 

/ d' 'T* ^ *^N v dr' d' ^b 4' d' <b ^b *t* d^ ^b d' d' ^ d* d' d^ f b *b <b / 

/X eqObcd logically compares two bed numbers X/ 
/X taken from the stack returns a value of one*/ 
/* if the numbers are equal, a zero if not. */ 
/*total number of bytes generated s 66 */ 

S vV *>±A ^ ^ \L+ viz « L» ^ S> \lA / 

/ #bd'd' # b'bd'vd'd'*bd>d>d'd'd'd' 'i* d* 'b m> d^ *b ^b d* d^d* ^b d* d* d* d'd*«bd' < bd» 
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eqSbcd.* proc(a) ; 
dc 1 a addr ; 

call gten(2lh, lah, 1 lh, 36h, 00h, 2dh, 36h, 00h, 2 lh, 19h) ; 

call gten(7eh,0d6h, ©8h, Qd2h, low( a+3eli) , high( a+3eh) , 4eh, 06h, 00h, 2eh) ; 
call gten(Q3h,09k,7eh,21h, 19h, 1 lh,5eh, 16h,00h,2eh) ; 

call gten( 10h, 19h, 4fh, 7eh, 9 lh, 0c2h, low(a+31h) ,high(a+31h) ,21h, lah) ; 
call gten( llh,36h,01k,2dh, 34h, 0c 3h, low( a + 8h) , high( a+8h) , 2 lh, lah) ; 
call gten( 1 lh, 36h, 00k, 2dh, 7eh, 0c6h, 03h, 77k, 0c 3h, low(a + 8h)) ; 
call genGf i ve ( liigh( a+8h) , 2ck, 4eh, 06h, OGh) ; 
call generate(GcSh) ; 
end eqObcd; 



/& geObcd logically compares two bed %/ 

/* numbers taken from the stack sfrid */ 

/% returns a value of one If the 1st %/ 
number is greater or equal to the 
second number, bytes genera ted= 324*/ 

/ * * * * * * * * * & X Jfc * * * * * * * * * >fc * * # * * * * 2*c :fc * « * / 
geSbed? proc(a); 
del a addr ; 

call gten(0c3h, low(a+0ech) , hi gh( a+Oec h) ,21h, leh,01h, 

36h, 0 lh, 2eh, lch) ; 

call gten( 7eh, Ofh, 0d2h, low(a+80h) ,high(a+891i) ,2eh, 19h, 7eh, 2ch, 96h) ; 
call gten(0c2h, low(a + 67h) ,high(a+67h) ,21h, leh, 0 lh, 7eh, 0d6h, 

08h, 0d2h) ; 

call gten(low( a*i-72h) , higli( a+72h) , 4eh, 06 h, QQh, 2eh, 08h, 09h, 7eh, 2 lh) ; 

call gten( 1 eh, 0 lh, 5eh, 16h,0Oh,2eh, 10h, 19h,4fh,7eh) ; 

call gten( 9 lh, 0c2h, low(a+3dh) ,high(a+3dh) ,21h, leli,01h,34h, 

0c3h, low(a+17h>) ; 

call gten( high( a+ 17h) ,21h, leh,01h,4eh,06h, 00h, 2eh, 08h, 09 h) ; 

call gten(7eh,2 lh, leh,01h,5eh, 16h,O0h,2eh, 10h, 19h) ; 
call gten(4fh,7eh,5fh,79h,93h,0d2h, low(a+5dh) ,high(a+5dh) ,21h, ldh) ; 
call gten(01h, 36h, 0 lh, 2 lli, leh, 0 lh, 7eh, 0c6h, 08h, 77h) ; 
call gten(0c3h, low(aT-17h) ,high(a+17h) , 2dh, 7eh, 2ch, 96h, 0d2h, 
low(a+72h) , high(a+72h) ) ; 

call gten(2eh, ldh, 361i, 0 lh, 2eh, leh, 7eh , 0d6h, 08h, 0c2h) ; 

call gien( lo w( a+Gebk) , high( a + 0ebh) , 2dh, 36h, 0 lh, 0c 3h, low(a+0ebh) , 

high( a+Oebh) ,2eh, 19h) ; 

call gt eu( 7eh, 2ch, 96h, 0c2h, !ow(a+0d6h) , high( a+0d6h) ,21h, leh,01h,7eh) ; 
call gten( 0d6k, 0Sh, 0d2h, low( a+Ge0h) , high( a+OeGh) , 4eh, 06h, 00h, 

2eh, 08h) ; 

call gten( 09h, 7eh,21h, leh,01h,5eh, 16h, 00h, 2eh, 10h) ; 

call gten( 19h, 4f h, 7eh, 9 lh, 0c2h, low(a+0aeh) , high( a+0aeh) ,21h, 

1 eh, 0 lh) ; 

call gt en( 34h, 0c3h, low(a+88h) ,high(a+80h) ,21h, leh, 0 lh, 4eh, 06h, 00h) ; 

call gten(2eh, 08h, 09h,7eh,21h, leh,01h,oeh, 16h, 00h) ; 

call gten(2eh, 10h, 19h, 4f h, 7eh, 9 lh, 0d2h, low(a+0cch) , high( a + 0cch) , 

2 lh) ; 

call gten( ldh, 0 lh, 36h, 0 lh, 2 lh, leh, 0 lh, 7eh, 0c6h, 08h) ; 

call gten( 77h, 0c3h, low( a+88h) , high( a+88h) , 7eh, 2dh, 96h, 0d2h, 

low( a+0e0h) , high( a+0e0h) ) ; 

cal 1 gten(2eh, ldh,36h,01h,2eh, leh,7eh,0d6h, 08h, 0c 2h) ; 
call gten(low( a+0ebh) , high( a+0ebh) , 2dh, 36 h, 0 lh, 0c 9h, 21h, ldh,01h,36h) ; 
call g ten( 00h, 2eh, Ibh, 36h, 0Oh, 2ch, 36h, 00h, 2eh, 08h) ; 
call gten( 7eh, 0e6h, 79h, 2e h, 19h,77h,2eh, 10h, 7eh, 0e6h) ; 
call gt en( 791i, 2eh, lah, 77h, 0a fh, 0d6h, 80h, 9f h, 2eh, 08h> ; 
call gten(0a6h,0fh, 0d2h, lo w( a+ 1 17h) , high( a+ 1 17h) ,2eh, lbh,36h,01h, 
0afh) ; 

call g ten( 0d6h, 80h, 9f h, 2eh, 10h, 0a6h, Of h, 0d2h, low(a+126h) , 
high( a+ 126h) ) ; 

call gten(2eh, 1c h, 36h, 0 lh , 2eh, lbh, 7eh, 2ch, 0a6h, 0fh) ; 
call g ten( 0d2h, lo w( a+ 135h) , high( a+ 135h) , 0cdh, low( a+3h) , high( a+3h) , 
0c3h, low(a+13dh) , high( a+ 13dh) ,7eh) ; 
call gten(0fh, 0d2h, iow(a+13dh) , high( a+ 13dh> , 2ch, 36h, 0 lh, 2 lh, ldh,01h) ; 
call genera te ( 4eh) ; 
call genera te( 06h) ? 
call gene ra te ( 00h) ; 
call genera te ( 0coh) ; 
end geSbcd; 
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/XXXXXXXXXXXXXXXiizXXXXXTicXXXXXXXXXXXXXacXXXXat/ 

/X witeOsti’ing calls the routine that */ 

/* prints the characters followed by the */ 
opcode, total no. bytes gen = 61 %/ 

/*****************************************/ 
writeOstrng: proc ; 
dc 1 a addr ; 
a = cspaddr ( 63) ; 

call gten(0c3h, low(a+2eh) ,high(a+2eh) , 2 lh, 08h, 0 lh, 7 lh, 2ch, 73h, 23k) ; 
call gten( 72h, 0c3h, 05h, OOh, 0c 9h, 21h,0ch,01h,71h,0eh) ; 
call gten( 02h, 5eh, 16h, 00h, Ocdh, low( a- 12) , high( a- 12) ,21h,3fh,01h) ; 
call gt en( 34h, 3eh, 4f h, 96h, 0d2h, low(a+2dh) , high( a-r2dh) , 0eh,02h, leh) ; 
call gten(0dh,16h, 09h, Ocdh, low( a - 12) , klgh( a-* 12) , Oeh, 02h, leh, Oah) ; 
call gten( 16h, OOh, Ocdh, low(a-12) ,higk(a-12) , 2 lh, 3f h, 0 lh, 36h, 00h) ; 
call genera te ( Gc9h) ; 
end wr iteSs trng; 



/# converts in t removes the first two */ 

/* bytes from the stack changes them to*/ 

/* a bed number and returns 8 bytes to */ 

/* the stack, total bytes = 383 */ 

/ % # % * * # # * * * * * * * * * # * X * * # * * * # * * * * * * * * * * * * * / 

convertSint: proc(a); 

del a addr; 

call gten(21h, 17h, 0 lh, 36h, 0 lh, 3eh, 07h, 21h, 17h,01h) ; 

call gten(96h,0dah,low( a+ ldh) , high( a + ldh) , 4eh, 06h, 00 h, 2eh, Oah, 09h) ; 
call gten( 36h, 00h, 2 lh, 17h, 0 lh, 34h, 0c2h, low(a+5h) ,hlgh(a+5h) ,36h) ; 
call gten( 00h, 3eh, 04h, 2 lh, I7h, 0 lh, 96 h , Odah , low( a+37h) , high( a+37h) ) ; 
call gten( 4eh, 06 h, 0Oh, 2eh, I2h, 09h, 36h, O0h, 2 lh, 17h) ; 

call g ten( 0 lh, 34h, 0c2h, low(a+lfh) ,high(a+lfh) , 2ch, 35h, OOh, 3eh, Of f h) 
call gten(06h,7fh,2eh, 08h, 96h,2ch,4fh, 78h, 9eh, 0d2h) ; 

call gten(low(a+59h), high( a+59h) , 2eh, 18h, 36 h, 0 lh, Oaf h, 2eh, 08h, 96h) ; 
call gten(2ch,4fh,3eh, GOh, 9eh, 2dh, 7 lh, 23h, 77h, 2eh) ; 
call gten( lah,36h, 10h, 23h, 36h, 27h, 2eh, 19h,36h,01h) ; 
call gt en( 2eh, Oah, 36 h, 45 h, 2 lh, 19h, 0 lh, 7eh, Ofh, 0d2h) ; 

call gten(low(a + 0cfh) , high( a+0c f h) , 2eh, 08h, 7ch, 2ch, 46h, 2eh, 1 ah, 96h) 
call gten( 2ch, 4f h, 78h, 9eh, Odah, low(a+86h) ,high(a+86h) ,2eh, 19h,36h) ; 
call gten( 00h, 0c 3h, low( a+68h) , high( a+63h) , leh, Oah, 16h, 00h, 2 lh, lah) ; 
call g ten( 0 lh, 4eh, 2ch, 46h, 0c3h, low(a+0c0h) , high( a+0c0h) , 7ah, 2f h, 57h) 
call gt en( 7bh, 2f h, 5 f h, 13h, 2 lh, 00h, 00h, 3eh, Ilh,0e5h) ; 
call gten( 19h,0d2h, low(a + 0a5h) , high( a+0a5h) , 0e3h, 0e lh, Of 5h, 79h, 
17h,4fh) ; 

call gten(78h, 17h,47h,7dh, 17h,6fh,7ch, 17h, 67h, Of lh) ; 
call gten( 3dh, 0c2h, low(a+9fh) ,high(a+9fh) ,0b7h,7ch, lfh,57h,7dh, lfh) 
call gten( 5fh, 0c9h, Ocdh, low(a+93h) ,high(a+93h) ,21h, lah, 0 lh, 7 lh, 23k) 
call gt en( 70h, 2eh, Oah, 35h, 0c3h, low(a+68h) ,high(a+68h) , 2dh, 7eh, Of h) ; 
call gten(0d2h, low(a+0dbh) , high( a+0dbh) , 2eh, Gah, 7eh, 0c6h, 80h, 77h, 2eh) 
call gten( 17h, 36 h, 00h, 0afh,21h, lah,0 lh, 96h, 2ch, 4f h) ; 
call gten(3eh, 00h, 9eh, 0d2h, low( a+ 13bh) , high( a+ 13bh) , 2eh, 17h, 4eh, 06h) 
call gten( OOh, 2eh, 12h, 09h, Oebh, 2 lh, Oeah, 03h, 73h, 2ch) ; 
call gt en( 72h, 2 lh, lah, 0 lh, oeh, 2ch, 56h, 2eh, 08h, 4eh) ; 

call gten( 2ch, 46h, Ocdh, low( a+93h) , high( a+93h) , 2ah, Oeah, 03h, 7 lh, 21h) 
call g ten( 17h, 0 lh, 34h, 21h, lah, O lh, 5eh, 2ch, 56h, 2eh) ; 

call gten( 08h, 4eh, 2ch, 46h, Ocdh, low( a+93h) , high( a+93h) , 2 lh, 08h, 0 lh) ; 
call gten( 73h, 23h, 72h, leh, Oah, 16h,00h,21h, lah,01h) ; 

call gten(4eh,2ch,46h,0cdh, low( a+93h) , high( a + 93h) ,21h, lah,01h,7lh) ; 
call g t en( 23h, 70h, 0c3h, low(a+0dfh) , high( a+0d f h) , 0 lh, 07h, OOh, 2eh, Oah) 
call g t en( 09h, Oebh, 2 1 h, 12h, 0 lh, 7eh, 87h, 87h, 87h, 87h) ; 
call gten(0d5h,4fh,Oc5h,23h,7eh,Odlh,83h,0e lh,77h,01h) ; 
call gten( 06h, OOh, 21h,0ah,01h, 09h, 0e5h, 0 lh, 02h, 00h) ; 
call g ten( 2 lh, 12h, O lh, 09h, 7eh, 87h, 87h, 87h, 87h, 1 lh) ; 
call gten( 03h, OOh, 2 lh, 12h, 0 lh, 19h, 4fh,7eh,81h,0elh) ; 
call gten( 77h, 0 lh, 05h, OOh, 2 lh, Oah, 0 lh, 09h, 0e5h, 0 lh) ; 
call gt en( 04h, OOh, 2 lh, 12h, 0 lh, 09h, 7eh, 87h, 87h, 87h) ; 
call genera te ( 87h) ; 
call genera te ( Oe lh) ; 
call genera te ( 77h) ; 
end convertSint; 
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/************************tf**:fc:fc;fc***;rc£;f:*:*:#*&/ 

/* couvertCbcd pops the next eight bytes */ 

/* from the stack, converts the bed num */ 

/* to an integer number and returns it to*/ 

/* the stack, bytes generated = 313 */ 

/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX/ 

convertObcd: proc(a); 

dc 1 a addr ; 

call gten( 0c3h, lo w( a + 1 f h) , high( a+lfh) ,21h, 15h,01h,71h,2ch, 73h, 23h) 
call gten( 72h, 0c3h, 05h, 00h, 0c9h , 2 lh, 17h, 0 lh, 7 lh, 23h) ; 
call gten(70h,0eh, 09 h, 2dh, Sell, 2c h, 56h, Ocdh, low( a + 3h) , high( a + 3h) ) ; 
call g ten( 0c9h, 2 lh, 12h, 0 lh, 36h, OOh, 2eh, 10h,36h,00h) ; 
call g ten( 23h, 36h, 00h, 2eh, 081i, 7eh, 0e6h, 7f h, 4f h, 3eh) ; 
call gten( 45 h, 9 lh, 0d2h, low( a+4dh) , high( a+4dh) , 0c 3h, low( a+44h) , 
high(a+44h) ,45h,52h) ; 

call gten(52h,4fh,52h,2Oh,49h,4fh,20h,24h,Olh,3ah) ; 
call gten( 02h, Ocdh, low(a+0fh) ,high(a+0fh) ,0c3h, low(a+139h) , 
high( a+ 139h) , 7eh, 0e6h, 80h) ; 

call gten(0d6h, 80h, 0c 2h, low( a + 59h) , high( a+S9h) , 2eh, 12h, 36h, 0 lh, 2eh) 
call gten( 0Sh, 7eh,0e6h,7fh,0d6h,40h,2eh, I3h, 77h, 3eh) ; 
call gten( 7f h, 96h, 0d2h, low(a + 6bh) ,high(a+6bh) , 36h, OOh, 2ch, 36h, 07h) 
call gteu( Oath, 2 lh, 13h, 0 lh, 96 h, 0d2h, low( a+ 103h) , high( a+ 103h) , 

2ch, 4eh) ; 

call gten(06h, OOh, 2eh, 08h, 09h,7eh, leh, 04h, 0b7h, 1 f h) ; 

call gten( ldh,0c2h, low(a+80h) ,high(a+80h) , 06h, OOh, 4f h, 2 lh, 18h,01h) 

call gten(71h,2ch,70h, leh,0ah, 16h,0Gh,21h, 10h,01h) ; 

call gten(4eh, 2c h, 46 h, 0c3h, low( a + Obf h) , high( a+Ob fh) , 79 h, 93h, 

78h, 9ah) ; 

call gten( 0f2h, low( a+0a8h) , high( a+0a8h) , 60h, 69h, Oebh, 44h, 4dh, 

2 lh, OOh) ; 

call gten( OOh, Oebh, 78h, Gb lh, 0c8h, Oebh, 78h, lfh,47h,79h) ; 
call gten( 1 f h, 4f h, 0d2h, low(a + 0bah) , high( a+0bah) , 19h, Oebh, 29h, 

0c3h, low( a+Oach) ) ; 

call gte n( high( a+0ach) ,0cdh, low(a+9ch) ,high(a+9ch) ,21h, 18h,01h, 
4eh, 2ch, 46h) ; 

call gten( Oebh, 09h, 22h, 10h, 0 lh, 21h, Of 9h, 03h, 35h, Oaf h) ; 

call gten(96h, 0d2h, low(a+6eh) , high( a+6eh) , leh,0ah, 16h, OOh, 21h, lOh) 

call g ten( 0 lh, 4eh, 2ch, 46h, Ocdh, low(a+9ch) ,high(a+9ch) ,0d5h, 

2 lh, 14h) ; 

call gten( 0 lh, 4eh, Q6h, OOh, 2eh, 08h, 09h, 7eh, 0e6h, Of h) ; 
call gt en( 06h, OOh, 4fh,0dlh,69h, 6 Oh, 19h,22h, 10h,01h) ; 
call gten(21h, 14h, 0 lh, 35h, 2dh, 35h, 0c3h, low(a+6eh) ,high(a + 6eh) ,3eh) 
call gten(0ffh,06h,7fh,2eh, lOh, 96h, 2ch, 4f h, 78h, 9eh) ; 
call gten( 0d2h, low(a+ 124h) , high( a+ 124h) , 0c3h, low(a+lleh) , 
high( a+ 1 leh) , 45h, 52h, 52h, 4fh) ; 

call gteii( 52h, 20h, 49h, 4f h, 20h, 241i, 0 lh, low(a+114h) , high( a+ 1 14h) , 
Ocdh) ; 

call gten( low(a+0fh) ,high(a+0fh) ,21h, 12h, 0 lh, 7eh, Of h, 0d2h, 
low( a+ 139h) , high( a+ 139h) ) ; 

call gten(0afh,2eh, 10h, 96h,2ch,4fh,3eh, OOh, 9eh, 2dh) ; 
call genera te ( 7 lh) ; 
call genera te ( 23h) ; 
call genera te ( 77h) ; 
end convertSbcd; 



/*^ifc^^^i^:^:^^^:>K«)fc^5k*********************/ 

/* dump generates code for a carriage */ 

/* return and line feed character to */ 

/* the screen to start a new line. */ 

/* total number of bytes genera ted=38*/ 

dump • proc ; 

dc 1 a addr ; 
a = cspaddr(64); 

call gten(0c3h, low(a+0fh) ,high(a+0fh) , 2 lh, 08h, 0 lh, 7 lh, 2ch, 73h, 23h) 

call g ten( 72h, 0c3h, 05h, OOh, 0c9h, Oeh, 02h, leh,0dh, 16h) ; 

ca 1 1 gten( OOh, Ocdh, low( a+3h) , high( a + 3h) , Oeh, 02h, leh, Oah, 16h, OOh) ; 

call genSf i ve ( Ocdh, lo w( a + 3h) , high( a + 3h) , 2 lh, 3f h) ; 

call generate(Olh); 

call genera te ( 36h) ; 

call genera te ( OOh) ; 
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end dump; 



/XXX procedures called by case stmt XX*/ 



setCflags: proc ; 

del i byte; 
do i=l to 65; 

espe ( i ) 3 true ; 
end ; 

end setC flags; 



endp 1 : proc ; 

pass 1= false; 
pass2= true ; 
call se tSf lags ; 
call se tupScoraSf i le ; 
call re wi ndSp inSf i le ; 
call openSp inSf i le ; 
codestrt - varstrt + 
progSs ize = codestrt 
pinptr 3 pinrecsize; 
spSmax = max - 2; 
call genera te ( 3 lh) ; 
call genera te ( low( spSmax) ) ; 
call genera te ( high( spSmax) ) ; 
call genera te ( 0c3h) ; /X jmp 

call genera te ( low( codes tr t )) ; 
call genera te ( high( codes tr t )) ; 
do loop 3 1 to (varcount + 58); 

call genera te ( OOh) ; 
end ; 

end endp 1 ; 



varcount ; 

+ codecount ; 



/* lxi 



sp 

/X 


X/ 

max stack 


p tr 


X/ 


to 


code area 


X/ 






/X initial ize 


work area X/ 



endprog: proc ; 

pass2 = false; 

call genera te ( 0fbh) ; /X ei X/ 

call genera te ( 76h) ; /X hit X/ 

call genera te ( 76h) ; /X hit X/ 

call de le teSp inSf i le ; 

call wr i t eScomSf i le ; 

call c loseScomSf i le ; 

if erreount = 0 then do; 

call print(.*end of compilation, 
call pr intchar ( 0dh) ; /X 

call pr intc har ( 0ah) ; /X 

end ; 

else call print(.’ compilation 
call pr in tc har ( 0dh) ; 
call pr intc har ( 0ah) ; 
go t o boot; 
end endprog; 



no 

cr 

If 



program 

X/ 

X/ 



terminated due to error(s) 



secSpass: proc(a); 

del a addr ; 

call genera te ( 0cdh) ; /X call X/ 

call genera te( low( a) ) ; 
call genera te ( high( a ) ) ; 
end secSpass; 



lb 12 : proc ; 

del ( lb lnumber , lb laddr , n based lbladdr) addr; 

lblnumber 3 ge tSnex tSaddr ; 

lbladdr 3 .memory + ( 2 X lblnumber); 
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n = codecount; 
end lb 12 ; 



ldib3: proc; 

del i byte, a addr; 
do i= 1 to 4 ; 
a = ge tOnext Saddr ; 

call genSf i ve ( 0eh, lowCa) , 06h, high( a ) ,Oclli) ; 
end ; 

end ldib3; 



ldii4? proc; 

del a addr; 
a = ge tOnextSaddr ; 

call genCf i ve( Oeh, low( a) , 06h, high( a) , Oc lh) ; 
end Id 1 14 ; 



cnvb9 : proc ; 

dc 1 a addr ; 

call genera te ( 0c3h) ; /* Jmp 

call genera te( low( cspaddr( 9) + 358)); 
call genera te ( high( cspaddr( 9) + 358)); 



call popCsvSaddr( 106h) ; 
call popObcd( 108h) ; 
a = cspaddr(9) + 30; 
call convertSbcd(a) ; 
call pushS int ( 1 10h) ; 
call pushSsvSaddr ( 106h> ; 
call genera te ( 0c9h) ; 
call genera te < Ocdh) ; 
call genera te ( low( espaddr 
call genera te ( high( espadd 
end cnvb9; 



/* 7 bytes */ 

/* 23 bytes */ 

/* 313 bytes */ 
7 bytes 
/* 7 bytes */ 

/* ret 
/* call */ 

9) ) ) ; 

(9) ) ) ; 



envi 10 : proc ; 

dc 1 a addr ; 

call genera te ( 0c 3h) ; /* Jmp 

call genera te ( low( espaddr ( 10) + 428)); 
call genera te ( high( espaddr ( 10) + 428))? 



call popSsvSaddr( 106h) ; 




7 bytes %/ 


call pops int ( 108h) ; 


/* 


7 bytes 


a = cspaddr( 10) + 14; 






call co n ve rtSint(a) ; 


/* 


383 bytes */ 


call pushSbcd( 10ah) ; 




23 bytes 


call pushSs vSaddr ( 106h) ; 


/* 


7 bytes 



call genera te ( 0c9h) ; ret 

call genera te ( Ocdh) ; call 

call genera te ( low( espaddr ( 10) )) ; 
call genera te ( h igh( espaddr ( 10) ) ) ; 
end cnvilO; 



1 i ta 12 : proc ; 

dc 1 t addr addr ; 

taddr = ge tSnextSaddr + varstrt; 
call genera te ( 0 lh) ; /% lxi b %/ 

call genera te ( low( taddr )) ; 
call genera te ( high( taddr )) ; 
call genera te ( 0c5h) ; /% push b 

end lita!2; 



addbl3: proc; 
end addb!3; 



addil4: proc; 
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call genera t e (0c lh) ; 
call generate(Oelh) ; 
call genera te ( 09h) ; 
call genera te ( Oeoh) ; 
end add i 14; 



/* pop b */ 
pop h 

/* dad b */ 
push h %/ 



subbl5: proc ; 

t 

end subblS; 



sub i 16 *• proc ; 



call 


genera te C 0c lh) ; 


/* 


pop b */ 


call 


genera te C 0d lh) ; 


/% 


pop d 


call 


genera te C 79h) ; 


/* 


mova c 


call 


genera te C 93h) ; 


/% 


sub e %/ 


call 


genera te C 4bh) ; 


/* 


mo vc e 


call 


genera t e C 78h) ; 


/% 


mo va b 


call 


genera te C 9ah) ; 


/* 


sbb b */ 


call 


genera te C 47h) ; 


/* 


mo vb a */ 


call 


genera teC 0c5h) ; 


/* 


push b 



end sub i 16 ; 

mu lb 17*. proc; 
i 

e nd mu 1 b 1 7 ; 



mul i 18*. proc ; 

del a addr; 

call genera te ( 0c3h) ; /% jmp %/ 

call genera te ( low( cspaddr( 18) + 55)); 
call genera te C highC espaddr C 18) + 55)); 
call popOsvOaddrC 106h) ; 7 bytes 

a s cspaddrC 18) + 7; 

call multSint(a); /*40 bytes 

call pushGs vSaddr C 106h) ; 7 bytes 

call genera t e ( 0c9h) ; rtn %/ 

call genera te ( 0cdh) ; /% call 

call genera te ( cspaddrC 18) ) ; 
call genera te C cspaddrC 18) ) ; 
end mu 1118; 



d i vb 19 : proc ; 
? 

end divbl9; 



divi20: proc; 

del a addr ; 

call genera te ( 0c3h) ; jmp 

call genera te C lowC cspaddrC 20) + 69)); 

call genera te ( highC espaddr C 20) + 69)); 

call popSsvGaddrC 106h) ; 7 bytes 

a = cspaddrC20) + 7; 

call divGintCa); 54 bytes */ 

call pushSs vGaddr C 106h) ; /* 7 bytes */ 

call genera teC 0c9h) ; rtn %/ 

call genera te( 0cdh) ; call 

call genera te C espaddr C 20) ) ; 
call genera te C espaddr C 20) ) ; 
end divi20; 



lssb21* proc; 
5 

end lssb2l; 
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Iss 122 : proc ; 

del a addr ; 

call genera te ( 0c3h) ; /He jmp He/ 

call genera te ( low( espaddr ( 22) + 38)); 
call genera te ( high( espaddr ( 22) + 38)); 
call popSsvSaddr( 106h) ; /He 7 bytes He/ 

a = cspaddr(22) + 7; 

call lt8int(a); /He 23 bytes He/ 

call pushSsvOaddr ( 186h) ; /He 7 bytes He/ 

call genera te ( 0c9h) ; /He ret He/ 

call genera te ( Ocdh) ; /He call He/ 

call genera te ( low( espaddr ( 22) )) ; 
call genera te ( high( espaddr ( 22) ) ) ; 
end lss 122 ; 



leqb23: proc; 
5 

end leqb23; 



leqi24* proc; 
del a addr ; 

call genera te ( 0c3h) ; /He Jmp He/ 

call genera te ( low( espaddr ( 24) + 38)); 
call genera te ( high( cspaddr( 24) + 38)); 
call popGsvSaddr( 106h) ; /He 7 bytes He/ 

a = cspaddr(24) + 7; 

call leGint(a); /* 23 bytes He/ 

call pushGs vSaddr ( 106h) ; /He 7 bytes He/ 

call genera t e ( 0c9h) ; /He ret He/ 

call genera te ( Ocdh) ; /He call He/ 

call genera te ( low( espaddr ( 24) )) ; 
call generate( higli( cspaddr(24) ) ) ; 
end leqi24; 

eqlb25: proc; 

dc 1 a addr ; 

call genera te ( 0c3h) ; /* Jmp He/ 

call genera te ( low( espaddr ( 25) + 81)); 

call genera te ( high( espaddr ( 25) + 81)); 

/He 7 bytes He/ 



call pop8svSaddr( 106h) 
a = cspaddr(25) + 7; 
call e qSbcd( a) ; 

push$s vGaddr ( 106h) 
genera te ( 0c9h) ; 
genera te ( Ocdh) ; 
generate( low(cspaddr(25))) ; 
genera te( high( cspaddr(25))) 



call 

call 

call 

call 

call 



/He 66 bytes He/ 
/He 7 bytes He/ 
/He ret He/ 

/He call He/ 



end eqlb25; 



eqli26: proc; 

del a addr; 

call genera te ( 0c3h) ; /He jmp He/ 

call genera te ( low( espaddr ( 26) + 39)); 
call genera te ( high( espaddr ( 26) + 39)); 
call popSsvSaddr( 106h) ; /He 7 bytes He/ 

a = cspaddr(26) + 7; 

call eqSint(a); /He 24 bytes He/ 

call pushSsvSaddr ( 106h) ; /He 7 bytes He/ 
call genera te ( 0c9h) ; /He ret He/ 
call genera te ( Ocdh) ; /He call He/ 

call genera te ( low( espaddr ( 26) )) ; 
call genera te ( high( espaddr ( 26) ) ) ; 
end eql!26; 



eqls27: proc; 
» 

end eqls27; 
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neqb23: proc; 

del a addr ; 

call genera te ( 0c3h) ; Jmp X/ 

call genera te ( low( espaddr ( 28) + 82)); 

call genera te ( high( cspaddr( 28) + 82)); 

call popOsvOaddr( 106h) ; /% 7 bytes X/ 

a = cspaddr(28) + 7; 
call ne8bcd( a) ; 
call pushes vOaddr ( 1061i) ; 
call genera te ( 0c9h) ; 
call genera te ( Ocdh) ; 
call generate(low( espaddr ( 28) ) ) ; 
call genera t e ( high( espaddr ( 28) ) ) ; 



/X 67 bytes X/ 
/<*' 7 bytes X/ 
/X re t X/ 

/*f* call 



end neqb28; 



neqi29: proc; 

del a addr; 

call genera te ( 0c3h) ; Jmp */ 

call genera te ( lovK espaddr ( 29) + 39)); 
call genera te( high( espaddr ( 29) + 39)); 
call popGsvSaddr( 106h) ; /X 7 bytes */ 

a - cspaddr(29) + 7; 

call neSint(a); /% 24 bytes X/ 

call pushSs vSaddr ( 106h) ; 7 bytes X/ 
call genera te ( 0c9h) ; ret X/ 

call genera te ( Ocdh) ; /X call X/ 

call genera te ( low( espaddr ( 29) )) ; 
call generate( high( cspaddr(29))) ; 
end neqi29; 



neqs30: proc; 
end neqs30; 



geqb31: proc; 
? 

end ge qb3 1 ; 



geqi32: proc; 

del a addr ; 

call genera te ( 0c3h) ; /* Jmp 

call genera te ( low( espaddr ( 32) + 38)); 
call genera te( high( espaddr ( 32) + 38)); 
call pop3svGaddr( 106h) ; /% 7 bytes X/ 

a * cspaddr(32) + 7; 
call geSint(a); 
call pushSs v$addr( 106h) 
call genera te ( 0c9h) ; 
call genera te ( 0cdh) ; 
call generate( low(cspaddr( 32) ) ) ; 
call genera te ( high( espaddr ( 32) ) ) 
end geqi32; 



/* 23 bytes */ 
/% 7 bytes X/ 
/X re t X/ 

/X call X/ 



grtb33: proc; 
? 

end grtb33; 



gr t i34 : proc ; 

del a addr ; 

call genera te( 0c3h) ; /X jmp X/ 

call genera te( low( espaddr ( 34) + 38)); 
call genera te ( high( espaddr ( 34) + 38)); 

call popSsvSaddr( 106h) ; /X 7 bytes X/ 
a - cspaddr(34) + 7; 

call gtSint(a); /X 23 bytes X/ 
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call pushOsvSaddr ( 106h) ; /He 7 bytes He/ 

call genera te ( 0c9h) ; /He ret He/ 

call genera te ( 0c dh) ; /He call He/ 

call genera t e ( low( espaddr ( 34) ) ) ; 
call generate( high( espaddr ( 34) ) ) ; 



end gr t 134 ; 






negb35: 


proc ; 






ca 1 1 


genera te ( 0c lh) ; 


/He 


pop b */ 


call 


genera te ( 3ah) ; 


/He 


Ida */ 


call 


genera te( 89h) ; 


/He 


10000000 */ 


call 


genera te ( 8 lh) ; 


/He 


add c */ 


call 


genera te ( 4f h) ; 


/He 


move a */ 


call 


genera te ( 0c5h) ; 


/He 


push b */ 



end negb35; 



negi36 : proc ; 

call genera te ( 0c lh) ; 
call genera te ( Oa fh) ; 
call genera te ( 9 lh) ; 
call genera te ( 4fh) ; 
call genera te ( 3eh) ; 
call genera t e ( 00h) ; 
call genera te ( 98h) ; 
call genera te ( 47h) ; 
call genera te ( 0c5h) ; 
end negi36; 



/He pop b He/ 
/He xra a He/ 
/He sub c He/ 
/He move a He/ 
/He mvi a He/ 
/He ooh He/ 

/He sbe b He/ 

/He movb a He/ 
/He push b He/ 



comb37: proc; 

call genera te ( 0c3h) ; /He jrnp He/ 

call genera te ( low( espaddr ( 37) + 104)); 
call genera te ( high( espaddr ( 37) + 104)); 
call pop3sv0addr( 10eh) ; /He 7 bytes He/ 

call popSbcd( 106h) ; /He 23 bytes He/ 

call comp l$bcd( 106h) ; /He 43 bytes He/ 

call pushSbcd( 106h) ; /He 23 bytes He/ 

call pushSs vOaddr ( 10eh) ; /He 7 bytes He/ 

call genera te ( 0c9h) ; /He ret He/ 

call genera te ( 0cdh) ; /He call He/ 

call genera te ( low( espaddr ( 37) )) ; 
call generate( high( espaddr ( 37) ) ) ; 
end comb37; 



comi38** proc; 



call 


genera te ( 0c lh) ; 


/He 


pop 


b : 


*/ 


call 


genera te C 79h) ; 


/* 


mo va 


c 


He/ 


call 


genera te ( Oeeh) ; 


/He 


xr i 


He/ 




call 


genera te ( 0f fh) ; 


/He 


11111111 He/ 


call 


genera te ( 4f h) ; 


/He 


move 


a 


He/ 


call 


genera te ( 78h) ; 


/* 


mo va 


b 


He/ 


call 


genera te ( 0eeh) ; 


/* 


xr i 


He/ 




call 


genera te ( 0f fh) ; 


/He 


11111111 He/ 


call 


genera te ( 47h) ; 


/* 


mo vb 


a 


He/ 


ca 1 1 


genera te ( 0c5h) ; 


/He 


push 


b 


He/ 



end comi38; 



not39: proc; 

dc 1 a addr ; 
call genera te ( 0c3h) ; 



/He jmp He/ 

call genera te ( low( espaddr ( 39 ) + 34)); 
call genera te( high( espaddr ( 39) + 34)) 



call popSsvSaddr( 106h) ; 
a = cspaddr(39) + 7; 
call notSbool(a); 
call pushSsvSaddr ( 106h) ; 
call genera te ( 0c9h) ; 
call genera te ( 0cdh) ; 



/He 7 bytes He/ 

/He 19 bytes He/ 
/He 7 bytes He/ 
/He ret He/ 

/He call He/ 
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call generateC lo w( cspaddr ( 39) ) ) ; 
call generateC highC cspaddr(39) ) ) ; 
end not39; 



and40: proc; 

dc 1 a addr ; 

call genera te ( 0c3h) ; jmp 

call genera te ( low( cspaddr ( 40) + 41)); 
call genera te ( highC cspaddr ( 40) + 41)); 
call popSsvSaddrC 106h) ; /X 7 bytes X/ 
a = cspaddr(40) + 7; 
call andSboolCa); 
call pushSsvSaddr C 106h) 
call genera te ( 0c9h) ; 
call genera te ( 0cdh) ; 
call genera te ( low( cspaddr ( 40) )) ; 
call generateC highC cspaddr ( 40) ) ) ; 
end and40; 



/X 26 bytes X/ 
/'f* 7 bytes X/ 
/X re t */ 

/X call X/ 



bor4 1 : proc ; 

del a addr ; 

call genera teC 0c3h) ; /X jmp X/ 

call genera te C lowC cspaddr C 4 1 ) + 41)); 
call genera te C highC cspaddr C 4 1) + 41)); 

/X 7 bytes X/ 



call popSsvSaddrC 106h) 
a = cspaddrC41) + 7; 
call orSboo 1 C a) ; 
call pushOsvSaddr C 106h) 
call genera te C 0c9h) ; 
call genera te C 0cdh) ; 
call genera te C lowC cspaddr C 4 1 ))) ; 
call genera te C highC cspaddr C 4 1 )) ) 



/X 26 bytes 
/X 7 bytes 
/X ret X/ 

/X call X/ 



X/ 

X/ 



end bor41; 



stob42: proc; 

call genera te C 0c3h) ; /X jmp X/ 

genera te C lowC cspaddr C 42) + 44)); 
genera te C highC cspaddr C 42) + 44)) 



call 
ca 1 1 
call 
call 
call 
call 
call 
call 
call 
call 



end stob42; 



popSsvSaddrC 106h) ; /X 7 bytes X/ 

stoSbcd; /X 21 bytes X/ 

s v$s tackC bcdS len) ; /X 8 bytes X/ 

pushSs vSaddr C 106h) ; /X 7 bytes X/ 

genera te C 0c9h) ; /X ret 

genera te C 0cdh) ; /X call X/ 

generateC lowC cspaddr C 42) ) ) ; 
genera te C highC cspaddr C 42) ) ) ; 



s to 143 i proc ; 

call genera te C 0e lh) ; 
call genera te C 0c lh) ; 
call genera te C 7 lh) ; 
call gener a te C 23h) ; 
call genera te C 70h) ; 
call svSstackC intlen) ; 
end s to i43 ; 



/x pop h X/ 
/X pop b X/ 
/X movm c X/ 
/X inx h X/ 
/X mo vm b X/ 
/X 2 bytes X/ 



s to44 : proc ; 



call 


genera te C 0e lh) ; 


/X pop h 


X/ 


call 


genera te C 0c lh) ; 


/X 


pop b X/ 


call 


genera te C 71h) ; 


/X 


movm c 


X/ 


call 


genera te C 3bh) ; 


/X 


dex sp 


X/ 


call 


generateC 3bh) ; 


/X 


dex sp 


X/ 



end sto44; 
s tdb45 *. proc ; 
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call generate(0c3h) ; /* Jmp */ 

call generate( low( cspaddr( 45) + 36)); 
call genera te ( high( cspaddr( 45) + 36)); 
call popGsvOaddr( 106h) ; 7 bytes X/ 

call stoSbcd; /X 21 bytes X/ 

call pushSs vSaddr ( 106h) ; 7 bytes #/ 

call generate(0c9h) ; /* ret X/ 

call generate(0cdh) ; /X call X/ 

call genera te ( low( cspaddr( 45) )) ; 
call generate( high( cspaddr ( 45) ) ) ; 



end stdb45; 



otdi46: proc; 

call genera te( Oe lh) ; 
call genera te ( Oc lh) ; 
call genera te ( 7 lh) ; 
call genera te ( 23h) ; 
call genera te ( 70h) ; 
end stdl46; 



/X pop h X/ 
/X pop b X/ 
/X movm c X/ 
/X inx h X/ 
/X movm b X/ 



std47: proc; 

call genera te ( Oe lh) ; /X pop h X/ 

call genera te ( Oc lh) ; /X pop b X/ 

call generate(71h); /X movm c X/ 

end std47; 



cnai51: proc; 

del a addr ; 
call genera te ( 0c3h) 



call 

call 

call 

call 

call 



/X j rap X/ 
genera te ( low( cspaddr < 5 1 ) + 442)); 
genera te ( high( cspaddr ( 5 1 ) + 442)) 



popOs vOaddr ( 106h) 
popSs vOaddr ( 1 lbh) ; 
popSint( 108h) ; 
a = cspaddr(ol) + 21; 
call co n ve rtSint(a) ; 
cal 1 pushSbcd( lOah) ; 
call pushSsvGaddr ( 1 lbh) ; 
call pushSs vSaddr ( 106h) ; 
call genera te ( 0c9h) ; /X 

call genera te ( Ocdh) ; /X 

call genera te ( low( cspaddr ( 5 1 ))) ; 
call gener a te ( high( cspaddr ( 5 1 ) ) ) 



/X 
/X 7 
/X 



7 bytes X/ 
bytes X/ 

7 bytes X/ 



/X 383 bytes X/ 
/X 23 bytes X/ 
/X 7 bytes X/ 

/X 7 bytes X/ 

ret X/ 
call X/ 



end cna i5 1 : 



brl52: proc; 

del ( lb 1 , to t , lb laddr , n based lbladdr) addr; 

lbl = ge tSnextSaddr ; 

lbladdr - .memory + (2 X lbl); 

tot = n + codestrt; 

call genera te ( 0c3h) ; Jmp X/ 

call generate(lovKtot)); 
call genera te( high( to t) ) ; 
end brl52; 



blc53: proc; 

del ( lb 1 , to t , lb laddr , n based lbladdr) addr; 
lbl = ge tSnextSaddr ; 
lbladdr = .memory + (2 X lbl); 
tot = n + codestrt; 
call gene ra t e ( Oc lh) ; 
call genera te ( 79h) ? 
call genera te ( Of h) ; 
call gene ra te ( Odah) ; 
call generate( low( tot) ) { 
call gene ra te ( high( t o t ) ) ; 
end blc53; 



/X po p b X/ 
/X mova c X/ 
/X rrc X/ 

/X jc 
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cn2 154 : 
del 
call 
call 
call 
call 
call 
call 
a - 
call 
ca 1 1 
call 
call 
call 
call 
call 
call 
end cn2i 



proc ; 
a addr; 

genera te ( 0c3h) ; /* jmp 

genera te ( low( cspaddrC 54) + 474)); 
genera te C highC cspaddrC 54) + 474)); 



popGs vCaddr ( 106h) ; 
popSbcdC 1 lbh) ; 
popGintC 108a) ; 

cspaddrC 54 ) + 37; 
c o nve rtSint(a) ; 
pushSbcd( lOah) ; 
pushSbcd( 1 lbh) ; 
pushOs vGaddr ( 106h) 
genera te( 0c9h) ; 
genera te ( Gcdh) ; 
genera t e ( lowCcspaddrC54))) ; 
genera te ( hlgh( cspaddr(54)) ) ; 

54; 



7 bytes %/ 
/* 23 bytes */ 

7 bytes 

/* 383 bytes 
23 bytes 
23 bytes 

7 bytes 

ret 

/* call */ 



lodoS : proc ; 

call genera te ( Oe lh) ; 
call genera te( 4eh) ; 
call genera te( G6h) ; 
call genera te ( GGh) ; 
call genera te ( 0c5h) ; 
end lod55; 



pop h 
/J#c move m 
/% mvi b 
/* G */ 

/* push b */ 



lodb56: proc; 

call genera te ( Gc3h) ; J rap 

call genera te C lowC cspaddrC 56) + 36)); 
call genera te C highC cspaddrC 56) + 36)); 
call popOsvGaddrC 106h) ; /* 7 bytes */ 

call lodSbcd; 21 bytes 

call pushSs vSaddr C lG6h) ; 7 bytes %/ 

call genera te ( Gc9h) ; ret 

call genera te ( Gcdh) ; call %/ 

call genera te( lowC cspaddrC 56) ) ) ; 
call generateC highC cspaddr(56) ) ) ; 
end lodb56; 



lod 157 : proc ; 

call genera te C Ge lh) ; 
call genera te ( 4eh) ; 
call genera teC 23h) ; 
call genera te( 46h) ; 
call genera teC Gc5h) ; 
end lod 157 ; 



rdvb58: proc ; 
» 

end rdvb58; 



rdvi59: proc; 
end rdvi59; 



rdvs6G : proc ; 

? 

end rdvs6G; 



wrvb 6 1 : proc ; 

del a addr; 

call genera te ( Gc3h) ; /% Jmp %/ 

call genera te ( low( cspaddrC 6 1 ) + 502)); 
call genera te C highC cspaddrC 6 1 ) + 5G2) ) ; 



/% pop h 
/% move m 
/% Inx h 
/* movb m 
push b %/ 
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call popSsvSaddr( 106h) ; 
call popSbcd( 108h) ; 
a = cspaddr(61) + 30; 
call pr in tSbcd( a) ; /* 

call pushSs vSaddr ( 106h) ? /* 

call genera te ( 0c9h) ; /* 

call genera te ( Ocdh) ; /% 

call genera te ( low( cspaddr( 6 1) )) ; 
call genera te ( higli( cspaddr ( 6 1) ) ) 
end wrvb6 1 ; 



7 bytes 
23 bytes 

464 bytes 
7 bytes 
ret */ 
call */ 



wrvi62t proc; 

del a addr ; 

call genera te ( 0c3h) ; /% jmp %/ 

call generate( low( cspaddr ( 62) + 592)); 

call genera te ( high( cspaddr ( 62) + 592)) 
call popSs vSaddr ( 106h) ; 
call pops int ( 108h) ; 
a - cspaddr(62) + 14; 
call pr in tS int ( a ) ; 
call pushSs vSaddr ( 106h) ; 
call genera te ( 0c9h) ; 
call genera te ( Ocdh) ; 
call generate( low(cspaddr( 62) ) ) ; 
call generate( high( cspaddr(62) ) ) ; 
end wrvi62; 



7 bytes 
/* 7 bytes */ 

570 bytes 
/* 7 bytes 
ret 

/* call */ 



wvs63? proc(n); 

del (n, i,ch) byte; 
i = 0; 

do whi le i < n; 

ch = ge tSnextSbyt e ; 

call genera te ( 0eh) ; /% movi c %/ 

call genera te ( ch) ; 

call genera te ( Ocdh) ; call %/ 

call genera te ( low( cspaddr( 63) ) ) ; 
call generate( high( cspaddr ( 63) ) ) ; 
i = i + 1; 

end ; 

end wrvs63; 



dmp64 : proc ; 

call genera te C Gc3h) ; Jmp */ 

call genera te ( low( cspaddr ( 64) + 39)); 
call genera te( high( cspaddr ( 64) + 39)); 
call dump; 38 bytes 

call genera te ( 0c9h) ; /* ret */ 

call genera te ( Ocdh) ; /* call */ 

call genera te ( low( cspaddr ( 64) ) ) ; 
call generate( high( cspaddr(64))); 
end dmp64; 



y o/ \i» vu si# o * « >4 vv \L* 9* sL* \L * ^ ^ ^ \L* 4* 4^ vV 4 * 4^4* 4* ^ 4* ^ 4^ 4f 4* 4* 4* v> 4*4* V 4* 4* 4* 4* 4* 4* 4* 4* 4* 4* 4* 4*^4* 4* S 

/ ^ ^ /p ^ Sf * «T> *T» ^ ^ /p * t* *1* r v' *v* /b *v 

/*** interpreter main program ***/ 

y 4* 4* 4/ 4# 4# 4# 4* 4# 4*4*4* 4* '1* 4* 4*4*4* 4^4* 4* 4* 4* 4* 4* 4*4*4* 4* 4* 4* 4* 4* 4* tl* 4* 4* 4* 4* 4* 4* 4*4*4* 4* 4* 4* 4* 4* 4* 4*4*4* 4* 4* 4* 4* 4* 4* 4* 4* 4* % t*4*4* 4* 4* 4*4* 4*4* S 
/ *T+ *b *n *T* *T* *b «T**T* "T* *b *b *b ‘T* *T* *b *p *b *b *p*b*b*b < b *T* *b *b *p*b *T* *v* *b *b <T» *T* *b*b*b *b*p 'T* *b*b *b *|N *r» *b *b *b / 



call openSp inSf i 1 e ; 
call se tSf lags ; 
do while pass 1 or pass2; 

plncode = ge tSnextSbyt e ; 
do case pincode; 
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0 



nop 



no operation 



/* 



/% 1 endp 

if passl then call 
else call endprog; 



*/ 

- end of program %/ 
endp 1 ; 



/* 2 lb 1 — label 



if passl then call lbl2; 
e lse 

tempaddr = ge tOnex tSaddr ; 

/* 3 ldib - load immediate bed number 

if passl then. do; 

codecount = codecount + 20; 
tempaddr = ge tSnextSaddr ; 
tempaddr = ge tSnext Saddr ; 
tempaddr = ge tSnextSaddr ; 
tempaddr = ge tSnext Saddr ; 
end ; 

else call ldib3; 



4 ldii- load immediate integer 

if passl then do; 

code count = code count + 5; 
tempaddr = ge tSne xtSaddr ; 
end ; 

else call Id 114; 

/* 5 savp — save parameters (not implemented) 



/* 



/* 






6 unsp 

7 pro 

8 rtn 



unsave parameters (not implemented) X/ 
procedure call (not implemented) 
return from procedure (not implemented) 



*/ 



/* 9 envb - convert bed to integer 

i f pass 1 the n 
do ; 

if cspc(9) then 
do ; 

codecount= codecount + 364; 
espe ( 9 ) = fa lse ; 
end ; 

else codecount = codecount + 3; 

end ; 

else if cspc(9) then 
do; 

cspaddr(9 )= codesize + 3; 
call cnvb9; 
espe ( 9) = fa lse ; 

end ; 

else call secSpass ( cspaddr( 9) ) ; 



/% 10 f envi - convert integer to bed 

if passl then 
do ; 

i f espe ( 10) then 
do ; 

codecount= codecount + 434; 
c s pc ( 1 0 ) = false; 
end ; 

else codecount = codecount + 3; 
end ; 
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else if cspc(lO) then 
do ; 

cspaddr(10)= codesize + 3; 
call c n v i 1 0 ; 
cspc(10)= false; 

end ; 

else call secOpass ( cs paddr ( 1 0) ) ; 



11 all - allocate variable 

if passl then do; 

tempaddr = ge tSnextSaddr; 
varcount = varcount + tempaddr; 
end ; 

else tempaddr = ge tSnextSaddr ; 

/* 12 1 i ta - literal address */ 

if passl then codecount = codecount + 4; 
e lse call lital2; 

/* 13 addb - add bed numbers X/ 



/$ 14 addl - add integer numbers 

if passl then codecount * codecount + 4; 
else call add i 14 ; 

/* 15 subb - subtract bed numbers %/ 

\ 

16 subi - subtract integer numbers 

if passl then codecount = codecount + 9; 
else call subi 16; 



/% 17 mu lb - multiply bed numbers 



/* 18 muli - multiply integer numbers */ 

if passl then 
do ; 

1 f espe (18) then 
do ; 

codecount= codecount + 61; 
cspc( 18) = false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(18) then 
do ; 

cspaddr(18)= codesize + 3; 
call mul i 18; 
espe ( 18) = false; 

end ; 

else call secSpass ( cspaddr( 18) ) ; 






/* 



19 


d ivb — 


divide 


bed numbers 


*/ 


20 


d i vi “ 


d ivide 


integer numbers %/ 


(1 


then 








f 


cspc(20) then 









do ; 
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codecount 3 codecount + 75; 
cspc(20)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(20) then 
do ; 

cspaddr ( 20) = codesize + 3; 
cspc ( 1 ) = fa lse ; 
call divi20; 

end ; 

else call secSpass ( c spaddr ( 20) ) ; 



/* 21 lssb - less than compare, bed 



/% 22 lssi “ less than compare, Integer 

if passl then 
do ; 

if cspc(22) then 
do ; 

codecount 3 codecount + 44; 
cspc(22)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc (22) then 
do ; 

cspaddr(22)= codesize + 3; 
call lssi22? 
cspc(22)= false; 

end ; 

else call sec Spass ( espaddr ( 22) ) ; 



23 leqb - less than or equal compare, bed */ 



/% 24 leqi - less than or equal compare, Integer 

if passl then 
do ; 

if cspc (24) then 
do ; 

codecount 3 codecount + 44; 
cspc(24)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(24) then 
do ; 

cspaddr(24)= codesize + 3; 
call le qi24 ; 
cspc(24)= false; 

end ; 

else call secSpassCcspaddrC24) ) ; 



/* 25 eqlb - equal compare, bed 

if passl then 
do ; 

if cspc (25) then 
do ; 

codecount 3 codecount + 87; 
cspc(25)= false; 
end ; 

else codecount = codecount + 3; 
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end ; 

else if cspc(25) then 
do ; 

cspaddr ( 25) = codesize + 3; 
call eqlb25; 
cspc(25)= false; 

end ; 

else call secSpassC cspaddr( 25) ) ; 



/* 26 eqli - equal compare, integer */ 

if passl then 
do ; 

if cspc(26) then 
do ; 

c o d e c o un t = codeco un t + 45 ; 
cspc(26)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(26) then 
do ; 

cspaddr(26)= codesize + 3; 
call e ql i26 ; 
cspc(26)= false; 

end ; 

else call secSpass ( cspaddr ( 26) ) ; 



/* 27 eqls - equal compare, string 



/% 28 ne qb — not equal compare, bed 

if passl then 
do ; 

if cspc(28) then 
do ; 

c o dec o un t = codecount + 88; 
cspc(28)= false; 
end ; 

else code count = code count + 3; 
end ; 

else if cspc(28) then 
do ; 

cspaddr(28)= codesize + 3; 
call neqb28; 
cspc(28)= false; 

end ; 

else call secSpass ( cspaddr ( 28) ) ; 



%/ 



/X 29 neqi - not equal compare, integer 

i f pass 1 then 
do ; 

If cspc(29) then 
do ; 

codecount* codecount + 45; 
cspc<29)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(29) then 
do ; 

cspaddr<29)= codesize + 3; 
call neqi 29; 
cspc(29)= false; 

end ; 

else call secSpass ( cspaddr ( 29 )) ; 



/* 30 neqs - not equal compare, string */ 
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/* 

/* 



/* 

/% 



/* 

/* 

/* 



31 geqb ” greater or equal compare, bed •%/ 



32 ge qi - greater or equal compare, integer */ 

i f pass 1 then 

do ; 

if cspc(32) then 
do ; 

codecount= codecount + 44; 
cspc(32)= false; 
end ; 

else co decount = code count + 3; 
end ; 

else if cspc(32) then 
do ; 

cspaddr(32)= codesize + 3; 
call geqi32; 
cspc(32)= false; 

end ; 

else call secSpass ( espaddr ( 32) ) ; 



33 


gr t b 


greater 


than 


compare , 


bed */ 


34 


gr t i 


grea ter 


than 


compare , 


i n t e ge r 


pass 1 then 
do ; 













if cspc(34) then 
do ; 

codecount= codecount + 44; 
cspc(34)= false; 
end ; 

else code count = code count + 3; 
end ; 

else if cspc(34) then 
do ; 

cspaddr(34)= codesize + 3; 
call gr t i34 ; 
cspc(34)= false; 

end ; 

else call secSpass ( espaddr ( 34) ) ; 



35 negb - change sign of bed 

if pass 1 then codecount s codecount + 6; 
else call negb35; 



36 negi - change sign of integer 

if passl then codecount= codecount + 9; 
else call negi36; 

37 comb - complement (9*s) bed %/ 

i f pass 1 then 
do ; 

if cspc(37) then 
do ; 

c o d e c o un t s codeco un t + 110; 

cspc(37)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(37) then 
do ; 

cspaddr(37)= codesize + 3; 
ca 1 1 corab37 ; 
cspc(37)= false; 



216 



end ; 

else call secGpass ( cspaddr ( 37) ) ; 



33 com! — complement (2*s) integer &/ 

If pass 1 then code count = codecount + 10; 

else call comi33; 

39 not - boolean negative 

i f pass 1 then 
do ; 

if cspc(39) then 
do ; 

codecount= codecount + 40; 
cspc(39)= false; 
end ; 

else codecount = codecount + 3; 

end ; 

else if cspc(39) then 
do ; 

cspaddr(39)= codesize + 3; 
call not39; 
cspc (39)= false; 

end ; 

else call sec3pass ( cspaddr ( 39) ) ; 

40 and - logical and 
i f pass 1 then 

do ; 

if cspc(40) then 
do ; 

codecount= codecount + 47; 
cspc(40)= false; 
end ; 

else codecount = codecount + 3; 

end ; 

else if cspc(40) then 
do ; 

cspaddr(40)= codesize + 3; 
call and 40 ; 
cspc(40)= false; 

end ; 

else call secGpass ( cs paddr( 40) ) ; 



41 bor - logical or 

if passl then 
do ; 

if cspc(41) then 
do ; 

codecount 5 codecount + 47; 
cspc (41)= fa lse ; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(41) then 
do ; 

cspaddr(41)= codesize + 3; 
call bor4 1 ; 
cspc (41)= false; 

end ; 

else call secGpass ( cspaddr ( 4 1 )) ; 



/% 42 stob - store bed 

i f pass 1 then 
do ; 

if cspc(42) then 
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/* 



/* 



/* 



/* 



/* 



/* 



/% 



/% 



/% 



do ; 

codecount= codecount + 50; 
cspc(42)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(42) then 
do ; 

cspaddr(42)= codesize + 3; 
call s tob42 ; 
cspc(42)= false; 

end ; 

else call secSpass ( cspaddr ( 42) ) ; 



43 s^o i - 

if pass 1 then codecount 
e Ise call s to 143 ; 

44 s to - 

if pass 1 then codecount 
else call sto44; 

45 stdb - 



store integer 
= codecount + 7; 

store byte 
- codecount + 5; 

store destruct bed 



if passl then 
do ; 

if cspc<45) then 
do ; 

codecount= codecount + 42; 
cspc(45)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else If cspc(45) then 
do ; 

cspaddr(45)= codesize + 3; 
call stdb45; 
cspc(45)= false; 

end ; 

else call secSpass ( cspaddr ( 45) ) ; 



46 stdi - store destruct integer 

if passl then codecount = codecount + 5; 
else call stdi46; 

47 std - store destruct byte 

if passl then codecount = codecount + 3; 
else call std47; 

43 derb - decrement stack bed 

if passl then codecount = codecount + 8; 
else call unsvSs tack(bcdSlen) ; 

49 dcri - decrement stack integer X/ 

if passl then codecount = codecount + 2; 
else call unsvSs tack( intS len) ; 

50 dcr - decrement stack byte %/ 

if passl then codecount = codecount + 2; 
else call uns vSs tack( intS len) ; 

51 cna i - convert integer preceeded by address %/ 

i f pass 1 then 
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+ 448; 



do ; 

if cspc(ol) then 
do ; 

codecount= codecount 
cspc(51)= false; 
end ; 

else codecount 2 codecount + 3; 

end ; 

else if cspc(ol) then 
do ; 

cspaddr(5I)= codesize + 3; 
call cna i5 1 ; 
cspc(51) * fa lse ; 

end ? 

else call secSpass ( cspaddr( 5 1) ) ; 

/X 52 br 1 - branch label absolute 

if passl then 
do ; 

codecount = codecount + 3; 
tempaddr = ge tGnextSaddr ; 
end ; 

e lse call br 152 ; 

/% 53 blc - branch label conditional 

if passl then 
do ; 

codecount 2 codecount + 6; 
tempaddr = ge tSnext Saddr ; 
end ; 

e lse call b lc53; 

/* 54 cn2i - convert integer prececded by bed */ 

if passl then 
do ; 

if cspc(54) then 
do ; 

codecount 5 codecount + 480; 
cspc(54)= false; 
end ; 

else codecount 2 codecount + 3; 
end ; 

else if cspc(54) then 
do ; 

cspaddr(54)= codesize + 3; 
call cn2i54; 
cspc(54)= false; 

end ; 

else call se cSpass ( cspaddr( 54) ) ; 

/* 55 lod - load byte 

if passl then codecount = codecount + 5; 
else call lod55 ; 



/* 56 lodb - load bed number */ 

i f pass 1 then 
do ; 

if cspc(56) then 
do ; 

codecount 2 codecount + 42; 
cspc(56) 2 false; 
end ; 

else codecount 2 codecount + 3; 
end ; 

else if cspc<56) then 
do ; 

cspaddr(56)= codesize + 3; 
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/* 






/% 



/* 



/* 



call lodb56; 
cspc ( 36) = fa lse ; 

end ; 

else call secSpass( cspaddr( 56) ) ; 



37 lodi - load Integer number */ 

if pass 1 then codecount = codecount + 5; 
e lse call lod i57 ; 

58 rdvb - read variable bed 

if passl then 
do ; 

if cspc (58) then 
do ; 

codecount= codecount + 1; 

cspc(58)= false; 

end ; 

else codecount = codecount + 3; 

, end ; 

else if cspc(58) then 
do ; 

cspaddr(58)= codesize + 3; 
call rdvb58 ; 
cspc(58)= false; 

end ; 

else call sec Spass ( espaddr ( 58) ) ; 



59 rdvi - read variable integer 

if passl then 
do ; 

if cspc(59) then 
do ; 

codecount= codecount + 1; 
cspc(59)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc (59) then 
do ; 

cspaddr(59)= codesize + 3; 
call rdvi59 ; 
cspc(59)= false; 

end ; 

else call secSpass ( espaddr ( 59 )) ; 



60 rdvs - read variable string */ 



61 wrvb — write variable bed */ 

if passl then 
do ; 

if cspc (61) then 
do ; 

codecount 2 codecount + 508; 
cspc (61)= fa lse ; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(6l) then 
do ; 

cspaddr(61)= codesize + 3; 
call wrvb6 1 ; 
cspc (61)= false; 

end ; 

else call secSpass ( espaddr ( 6 1 )) ; 
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/X 62 ^srr v i - write variable integer X/ 

if pass 1 then 
do ; 

if cspc(62) then 
do ; 

codecount= codecount + 598; 
cspc(62)= false; 
end ; 

else codecount = codecount + 3; 

end ; 

else if cspc(62) then 
do ; 

cspaddr(62)= codesize + 3; 
call wrvi62 ; 
cspc(62)= false; 

end ; * 

else call secSpass ( cspaddr ( 62) ) ; 

/X 63 wrvs - write variable string X/ 

if pass 1 then 
do ; 

if cspc(63) then 
do ; 

tempbyte = ge tS next Gbyte ; 

codecount - codecount + 61 + doub le ( tempbyte ) X 5 
cspc(63)= false; 
end ; 

else do; 

tempbyte = ge tSnextSby t e ; 

codecount = codecount + doub le ( tempbyte ) X 5; 
end ; 

do loop : 0 to tempbyte; 

pincode = ge tSnextSby t e ; 
end ; 
end ; 

else if cspc(63) then 
do ; 

cspaddr(63)= codesize + Ofh; 

call wr i teJstrng; /X 61 bytes X/ 

tempbyte = ge tSnextSby t e ; 

call wrvs63( tempbyte ) ; 

cspc(63)= false; 

end ; 

else do ; 

tempbyte = ge tSnext Sbyt e ; 
call wrs t63( tempbyte ) ; 
end ; 

/X 64 dmp - start new output line X/ 

if passl then 
do ; 

if cspc(64) then 
do ; 

codecount 2 codecount + 45; 
cspc<64)= false; 
end ; 

else codecount = codecount + 3; 
end ; 

else if cspc(64) then 
do ; 

cspaddr(64) = codesize + 3; 
call dmp64; 
cspc(64)= false; 

end ; 

else call secSpass ( cspaddr ( 64) ) ; 

/* 65 not used X/ 

do ; 

call error ( ’co' ) ; /X code overflow 
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call endprog ; 



end ; 



end; /* case pincode 

end; do while pass 1 

end ; 
eo f 
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